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1.0 Introduction 


The Dioim in a liquid rocket can assume complex configurations due to 
multiple^tahks , multiple engines, and structures that must be piped 
around. The capability to handle some of these complex configurations 
have been incorporated into the NYQUIST code. The capability to 
modify the input on line has been implemented. 

The configurations allowed include multiple tanks, multiple engines, 
the splitting of a pipe into unequal segments going to different (or 
the same) engines. This program will handle the following type 
elements 


Straight pipes 
Bends 

Inline accumulators 
Tuned stub accumulators 
Helmholtz resonators 
Parallel resonators 
Pumps 

Split pipes 
Multiple tanks 
Multiple engines 


The code is too large to compile as one program using Microsoft 
FORTRAN V, therefore the code was broken into two segments: 

NYQUIST1 . FOR and NYQUIST2.P0R. These are compiled separately and then 
linked together. The final run code is not too large («344,000 


bytes) . 
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2.0 Input Description 

NYQUIST uses the following files: ENG.RLN, LOX.RLN, FUH1.RLN, and 
CONST. RLN. All files are in free format, therefore each of the 
following records will give the same results. 

Record 1: 1.000000E-01 6219.000000 2.670000 2.330E-03 -315.0000 

Record 2: 0.1 6219.0 2.67 0.00233 —315.0 

Record 3: l.E-01 

6219.0 
2.67 
2.33E-3 
-315.0 


The file assignments are given in the following table. 


Unit 

File Name 

File Tyi 

9 

ENG.RIN 

Input 

10 

LOX.RLN 

Input 

11 

FUEL.RLN 

Input 

12 

CONST. RLN 

Input 

13 

SURF. ERR 

Output 

14 

NYQ.OUT 

Output 

15 

(IOX) 

Work 

16 

(FUEL) 

Work 

17 

(RESULT) 

Work 


Description 
Engine data 

LOX tanks & lines data 
Fuel tanks & lines data 
Chamber data 

Convergence error information 
K() values 

Temporary file with LOX data 
Temporary file with fuel data 
T emp orary file for results 


2.1 Description of file ENG.RLN 

Card # 1 

number of engines 
Card # 2 

total flow in engine (lkm/sec) , 
chamber pressure (lbf/ft 2) , 
pressure drop across orifice (lbf/ft 2) 
Read card # 2 "number of engines" times 


2.2 Description of files LOX.RLN or FUEL.RLN 

Card # 1 
title 
Card # 2 

number of tanks 
Card # 3 

volume (ft~3) , 
mass flow (lkm/ sec) , 
bulk modulus (lbf/ft~2) , 
density (ltm/ft~3) 
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Read car d # 3 "number of tanks" times 

Card #4 . 

number of lines leaving tank 

Card # 5 

tank number, 

engine number (0 if split follows) 

Card # 6 

number of segments, 
number of unique splits 
Card # 7 

section type, 
pipel, 
pipe2, 
pipe3, 
pipe4, 
pipe5 

Read car d # 7 "number of segments" times 
if split > 0 
Card # 8 

number of segments, 
number of identical lines, 
engine number 
Card # 9 

section type, 
pipel, 
pipe2, 
pipe3, 
pipe4, 
pipe5 

Read card # 9 "number of segments" times 
Read card # 8-9 "number of splits" times 
Read card # 5-9 "number of lines" times 

where 


type 

name 

PIPEl 

PIPE2 

PIPE3 

PIPE4 

PIPES 

0 

bend 

radius 

angle 

diameter 

end len. 


1 

straight 

length 

diameter 




2 

inline 

length 

diameter 




3 

tuned 

length 

diameter 




4 

Helmholtz 

length 

diameter 

volume 



5 

parallel 

length 

diameter 

volume 



6 

pump 

length 

diameter 

dp/dm 

L 

C 

7 

manifold 

volume 

bulk mod. 
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Dimensions: 

radius, length, diameter, end length 
angle 

volume _ ,r — 

dp/dm (non-dimensionalized by m/p c ) 

L 

C 

bulk modulus 


2.3 Description of file CONST. RLN 

Card # 1 

transport lag (sec) , 
characteristic velocity (ft/ sec) , 
mixture ratio, 

characteristic time constant (sec) , 
change in velocity with mixture ratio (ft/sec) 
Read card # 1 "number of engines" times 


- ft 

- deg 

- ft*3 

- non-dimensional 

- sec 

- sec 

- lbf/ft‘2 


3.0 Output Description 

3.1 Output Files 

oatnut from the program is a file (NYQ.OOT) which may be printed and 

control of the user. The print file contains 

the following: 

Title, time, and date 
for no IOX of FUEL lines 

FREQ. K1(R) K1(I) 

for no FUEL line 

FREQ. K1(R) K1(I) ENG- K2(R) 

for no LQX line 

FREQ. K1(R) K1(I) ENG* K3(R) 

for both LOX and FUEL lines 

FREQ. K1(R) K1(I) 

eJg. K2(R) K2 (I) K3(R) *3(1) 


K2 (I) 
K3 (I) 


K4(R) 


K4 (I) 


Also if a split pipe is analyzed, a file (SURF. ERR) is created if any 
point fails^to converge within the specified number of iterations. 

This file contains: 


Title, time, and date 
jw = 


1 = 


after 

J= 


iterations has error of % in 
|G|= |GOLD| = 


line 
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3.2 Graphs Available 


“V'gS ^Snd/or IOX piping layouts for a specific engine. 

These are plotted upon request. 

2. The following plots are available upon request: 

a. Nyquist plot of K(jw) 

b. Nyquist plot of K(jw,Gox) 

c. Nyquist plot of K(jw,Gf) 

d. Nyquist plot of K(jw,Gox,Gf) 

e. Phase-Gain plot of K(jw) 

f. Phase-Gain plot of K(jw,Gox) 

g. Phase-Gain plot of K(jw,Gf) 

h. Phase-Gain plot of K(jw,Gox,Gf) 


if LOX line present 
if FUEL line present 
if LOX & FUEL lines present 


if LOX line present 
if FUEL line present 
if LOX & FUEL lines present 


4.0 Sample Run 

The sample run consists of two lox tanks ana four engines, two otthe 
engines aM lines going to them are identical. 

from each tank is the same, however the line from the £^nst tank is 
split with half the mass flow going to engine # 2 and the other half 
split into two identical engines # 1. 


4.1 Input for Sample Run 

Sample QJG.RLN file: 

3 

853.5 4.502040E+05 

1707.0 4.502040E+05 

3414.0 4 . 502040E+05 


1.610532E+06 

1.610532E+06 

1.610532E+06 


Sample LOX.RDJ file: 


Sample Run 


2 


1.956300E+04 

2928 

1.956300E+04 

2928 

2 


1 0 


13 2 


1 15.0 

1.416 

0 35.0 

45.0 

1 30.0 

1.416 

0 3.5 

135.0 

1 15.0 

1.416 

1 20.641 

1.416 

1 20.558 

1.416 

1 20.558 

1.416 

1 8.541 

1.416 

1 6.383 

1.416 


1.185883E+07 71.4 

1 . 185883E+07 71.4 


0.0 0.0 0.0 

1.416 0.0 0.0 

0.0 0.0 0.0 

1.416 0.0 0.0 

0.0 0.0 0.0 

0.0 0.0 0.0 

0.0 0.0 0.0 

0.0 0.0 0.0 

0.0 0.0 0.0 

0.0 0.0 0.0 


5 


0 4.25 90.0 1.416 0.0 0.0 

1 9.33 1.416 0.0 0.0 0.0 

0 3.33 80.0 1.416 0.0 0.0 

5 11 

1 3.53 0.708 0.0 0.0 0.0 

1 12.2 0.708 0.0 0.0 0.0 

0 1.28 35.0 0.708 0.0 0.0 

1 12.2 0.708 0.0 0.0 0.0 

7 13.5 1. 183346E+07 0.0 0.0 0.0 

5 i 2 

1 3.53 1.00126 0.0 0.0 0.0 

1 12.2 1.00126 0.0 0.0 0.0 

0 1.28 35.0 1.00126 0.0 0.0 

1 12.2 1.00126 0.0 0.0 0.0 

7 13.5 1. 183346E+07 0.0 0.0 0.0 

2 3 
18 0 

1 15.0 1.416 0.0 0.0 0.0 

0 35.0 45.0 1.416 0.0 0.0 

1 30.0 1.416 0.0 0.0 0.0 

0 3.5 135.0 1.416 0.0 0.0 

1 15.0 1.416 0.0 0.0 0.0 

1 20.641 1.416 0.0 0.0 0.0 

1 20.558 1.416 0.0 0.0 0.0 

1 20.558 1.416 0.0 0.0 0.0 

1 8.541 1.416 0.0 0.0 0.0 

1 6.383 1.416 0.0 0.0 0.0 

0 4.25 90.0 1.416 0.0 0.0 

1 9.33 1.416 0.0 0.0 0.0 

0 3.33 80.0 1.416 0.0 0.0 

1 3.53 1.416 0.0 0.0 0.0 

1 12.2 1.416 0.0 0.0 0.0 

0 1.28 35.0 1.416 0.0 0.0 

1 12.2 1.416 0.0 0.0 0.0 

7 13.5 1. 183346E+07 0.0 0.0 0.0 

Sample CONST. RLN file: 

0.1 6219.0 2.67 2.330000E-03 -315.0 

0.1 6219.0 2.67 2.330000E-03 -315.0 

0.1 6219.0 2.67 2.330000E-03 -315.0 
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4.2 Walkthrough of Sample Run 


Good Morning and Welcome to NYQUIST1 1 

Program NYQUIST provides stability predictions 
of feedline systems 

To send a plot to the printer 

The computer MUST be in GRAPHICS mode 

Hit PrScn to send the current plot to the printer 


If you want frequency in rad/sec, hit enter. 

If you want it in Hertz, enter "H". h 
Do you have FUEL data? n 
Do you have LOX data? y 

Is the engine data on file ENG.RLN? (Y/N) Y 
Is the lox file name LOX.RIN? (Y/N) y 
Max. no. of iterations is set at 20 
Do you wish to change it? n 
Do you wish to modify lox line data? . n 

Are the following variables in a file? (Y/N) 

VARIABLES 
TRANSPORT LAG 

CHARACTERISTIC ROCKET VELOCITY 
MIXTURE RATIO 

CHARACTERISTIC TIME CONSTANT 
CHANGE IN VELOCITY WITH MIXTURE RATIO 


X ls the name of the file CONST. RLN? (Y/N) y 
Enter 20 character title 
Sample Run 

Enter range of frequencies in Hertz 
Low freq, high freq, #pts 

1001 = Maximum number of points 

1 40 40 

The following LOX lines may be plotted 
Line # Tank # Engine # 

111 

2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 1 
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Sanple Run 10:53AM 12-12-91 

LOX Piping - Tank I 1 Engine t 1 
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The following LOX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 2 
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Sample Run 18:53AM 12-12-91 

LOX Piping ~ Tank t 1 Engine I 2 
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The following LDX lines may be plotted 

Line # Tank # Engine # 

1 1 1 

2 1 2 

3 2 3 

Enter line # to be plotted, 0 will end plot 3 


11 


Sanple Run 10:53A* 12-12-91 

LOX Piping - Tank i 2 Engine i 3 
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The following LOX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line § to be plotted, 0 will end plot. 4 . 
You did not enter a valid line #. Try again 

Enter line # to be plotted, 0 will end plot 0 
Please wait while computations proceed. 

Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 
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Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 


' Hie following LOX lines are available 

Line # Tank # Engine # 

1 1 1 

2 1 2 

3 2 3 

Enter line # to be plotted 1 
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Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 


' The following LOX lines are available 

Line # Tank # Engine # 

1 1 1 

2 1 2 

3 2 3 

Enter line # to be plotted 2 
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Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 

£ 

The following LOX lines are available 

Line # Tank # Engine # 

1 1 1 

2l 2 

3 2 3 

Enter line # to be plotted 3 
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Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 
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Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 


6 

The following LOX lines are available 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted 1 
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Sanple Run 10:53M 12-12- 1 



1.0 10.0 

Frequency - Hertz 


Eng. t 1 LOX TANK I 1 




Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 

6 

The following LOX lines are available 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted 2 
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188 * 


Sample Run 


10:53AH 12-12-91 


Phase Angle 


-188* 



1.8 18.8 180.8 
Frequency - Hertz 


.195 

Gain 

.153 

1.0 18.8 180.8 
Frequency - Hertz 

Eng. 12 LOX TANK t 1 
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Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 

6 

The following LOX lines are available 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted 3 
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188 * 

Phase Angle 

-188* 


Sample Run 11:31AM 12-12-91 



1.0 18.0 188.8 
Frequency - Hertz 


Eng. t 3 LOX TANK f 2 



1.8 18.8 188.8 
Frequency - Hertz 


X(ju,Gox) 
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Enter graph selection 

1 Nyquist plot independent of fuel or lox. 

2 Nyquist plot independent of fuel. 

5 Phase-Gain plot independent of fuel or lox. 

6 Phase-Gain plot independent of fuel. 

9 End plots. 

9 

Enter E to exit, 

F to run new frequency range, 

C to run a new case, 

N to read new files, e 


4.3 Output for Sample Run 


NYQ.OUT File 
Sample Run 
FREQ. 

1.0000E+00 

1. 0000E+00 

1.0000E+00 

1.3250E+00 

1.3250E+00 

1.3250E+00 

1 . 6500E+00 

1. 6500E+00 

1.6500E+00 

1.9750E+00 

1.9750E+00 

1.9750E+00 

2.3000E+00 

2.3000E+00 

2.3000E+00 

2.6250E+00 

2 . 6250E+00 

2 . 6250E+00 

2 . 9500E+00 

2.9500E+00 

2 . 9500E+00 

3 . 2750E+00 

3.2750E+00 

3.2750E+00 

3 . 6000E+00 

3 . 6000E+00 

3 . 6000E+00 

3 . 9250E+00 

3 . 9250E+00 

3.9250E+00 


10:53AM 

K1(R) 

1.6005E+00 -1. 
1 . 6005E+00 -1. 
1 . 6005E+00 -1. 
1. 3168E+00 -1. 
1.3168E+00 -1. 
1. 3168E+00 -1. 
9.7593E-01 -1. 
9.7593E-01 -1. 
9.7593E-01 -1. 
5.9263E-01 -1. 
5.9263E-01 -1. 
5.9263E-01 -1. 
1.8365E-01 -1. 
1.8365E-01 -1. 
1.8365E-01 -1. 
-2 . 3320E-01 -1. 
-2 . 3320E-01 -1. 
-2.3320E-01 -1. 
-6.3973E-01 -1. 
-6. 3973E-01 -1. 
-6. 3973E-01 -1. 
-1. 0183E+00 -1. 
-1.0183E+00 -1. 
-1.0183E+00 -1. 
-1. 3523E+00 -1. 
-1. 3523E+00 -1. 
-1. 3523E+00 -1. 
-1.6273E+00 -1. 
-1.6273E+00 -1. 
-1.6273E+00 -1. 


12-12-91 

K1(I) ENG. 

1990E+00 1 

1990E+00 2 

1990E+00 3 

5048E+00 1 

5048E+00 2 

5048E+00 3 

7451E+00 1 

7451E+00 2 

7451E+00 3 

9093E+00 1 

9093E+00 2 

9093E+00 3 

9904E+00 1 

9904E+00 2 

9904E+00 3 

9849E+00 1 

9849E+00 2 

9849E+00 3 

8930E+00 1 

8930E+00 2 

8930E+00 3 

7187E+00 1 

7187E+00 2 

7187E+00 3 

4698E+00 1 

4698E+00 2 

4698E+00 3 

1570E+00 1 

1570E+00 2 

1570E+00 3 


K2 (R) K2(I) 

3.0390E-01 -2.4404E-01 
1 . 5277E-01 -1.2105E-01 
7.6444E-02 -6.0587E-02 
2.4068E-01 -3 . 0540E-01 
1.2167E-01 -1.5172E-01 
6 . 1054E-02 -7 . 5997E-02 
1.6259E-01 -3 . 5084E-01 
8.3069E-02 -1.7467E-01 
4 . 1882E-02 -8.7884E-02 
6 . 9614E-02 -3.7361E-01 
3 . 6472E-02 -1.8630E-01 
1.8233E-02 -9.5210E-02 
-3.2350E-02 -3.4500E-01 
-1.5258E-02 -1. 6837E-01 
-1.7430E-02 -9.2128E-02 
-3.5376E-02 -2.9597E-01 
-2.2322E-03 -1.5421E-01 
3 . 6578E-02 -7.2733E-02 
-2 . 7266E-02 -6 . 1385E-01 
-5 . 1827E-02 -1.8444E-01 
-1.6659E-02 -9.4921E-02 
-1.6445E-01 -3 . 4257E-01 
-8 . 3960E-02 -1.7178E-01 
-4 . 2356E-02 -8.7415E-02 
-2.5095E-01 -2.9235E-01 
-1.2426E-01 -1.4770E-01 
-6.1878E-02 -7 . 5100E-02 
-3 . 1388E-01 -2.2656E-01 
-1. 5501E-01 -1. 1622E-01 
-7.7171E-02 -5.9359E-02 
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4.2500E+00 -1.8314E+00 -7.9403E-01 
4.2500E+00 -1. 8314E+00 -7.9403E-01 
4.2500E+00 -1. 8314E+00 -7.9403E-01 
4.5750E+00 -1.9557E+00 -3.9676E-01 
4.5750E+00 -1.9557E+00 -3.9676E-01 
4 . 5750E+00 -1.9557E+00 -3.9676E-01 
4.9000E+00 -1. 9948E+00 
4 . 9000E+00 -1.9948E+00 
4 . 9000E+00 -1.9948E+00 
5 . 8000E+00 -1.6588E+00 
5.8000E+00 -1. 6588E+00 
5 . 8000E+00 -1. 6588E+00 
6.7000E+00 -7.8406E-01 
6.7000E+00 -7.8406E-01 
6.7000E+00 -7.8406E-01 


7 . 6000E+00 
7.6000E+00 
7 . 6000E+00 
8 . 5000E+00 
8 . 5000E+00 
8.5000E+00 
9 . 4000E+00 
9.4000E+00 
9.4000E+00 
1.0300E+01 
1.0300E+01 
1.0300E+01 
1.1200E+01 
1. 1200E+01 
1. 1200E+01 
1.2100E+01 
1.2100E+01 
1.2100E+01 
1.3000E+01 


3.4342E-01 
3.4342E-01 
3.4342E-01 
1. 3559E+00 
1. 3559E+00 
1.3559E+00 
1.9244E+00 
1.9244E+00 
1.9244E+00 


1.2012E+00 

1.2012E+00 

1.2012E+00 

1.4954E-01 

1.4954E-01 

1.4954E-01 


1.7516E-02 

1.7516E-02 

1.7516E-02 

1.1044E+00 

1. 1044E+00 

1. 1044E+00 

1.8295E+00 

1.8295E+00 

1.8295E+00 

1.9578E+00 

1.9578E+00 

1.9578E+00 

1.4493E+00 

1.4493E+00 

1.4493E+00 

4.7142E-01 

4.7142E-01 

4.7142E-01 


-1.5660E+00 
-1.5660E+00 
-1 . 5660E+00 
-1.9637E+00 
-1.9637E+00 
-1.9637E+00 


-9.4578E-01 
L.3000E+01 -9.4578E-01 
L.3000E+01 -9.4578E-01 
1.3900E+01 -1.7289E+00 
1.3900E+01 -1.7289E+00 
1.3900E+01 -1.7289E+00 


-1.7221E+00 

-1.7221E+00 

-1.7221E+00 

-9.2304E-01 

-9.2304E-01 

-9.2304E-01 


1.8656E+00 -6.5608E-01 
1.8656E+00 -6 . 5608E-01 
1.8656E+00 -6.5608E-01 


1.4800E+01 -1.9471E+00 
1.4800E+01 -1.9471E+00 
1.4800E+01 -1.9471E+00 
1.5700E+01 -1.5329E+00 
1.5700E+01 -1.5329E+00 
1.5700E+01 -1.5329E+00 
1.6600E+01 -6.2440E-01 
1. 6600E+01 -6.2440E-01 


1 . 6600E+01 
1.8271E+01 
1.8271E+01 
1.8271E+01 
1.9943E+01 
1.9943E+01 


-6. 2440E-01 
1.3114E+00 
1.3114E+00 
1. 3114E+00 


1.7121E-01 

1.7121E-01 

1.7121E-01 

1.2039E+00 

1.2039E+00 

1.2039E+00 

1.8404E+00 

1.8404E+00 

1.8404E+00 

1.4188E+00 

1.4188E+00 

1.4188E+00 


1.8610E+00 -4.7155E-01 
1.8610E+00 -4.7155E-01 


1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 


-3 . 5779E-01 
-1.7715E-01 
-8.8310E-02 
-3.8254E-01 
-1.9036E-01 
-9 . 5089E-02 
-3.8760E-01 
-1.9432E-01 
-9.7336E-02 
— 2.9920E-01 
-1.5734E-01 
-8.0045E-02 
-6.6755E-02 
-5.5539E-02 
-3.2324E-02 
5.4292E-02 
2 . 9180E-02 
—3 . 8203E-02 
2.9148E-01 
1.3521E-01 
6.1280E-02 
3.5810E-01 
1.8464E-01 
9 . 3258E-02 
1.9654E-01 
1.6347E-01 
9. 1121E-02 
1.3862E-01 
9.4130E-02 
5.6674E-02 
1.5268E-01 
-8 . 2018E-02 
-4.7040E-03 
-9.4360E-02 
-2.2622E-02 
-3.3698E-02 
-2 . 9358E-01 
-1.4705E-01 
-8.2148E-02 


-1.4976E-01 
-7.9292E-02 
-4 . 1012E-02 
-6. 5826E-02 
-3 . 8747E-02 
-2.0895E-02 
2 . 1285E-02 
3 . 5422E-03 
1.0008E-04 
2.4542E-01 
1. 1401E-01 
5.5188E-02 
3 . 6850E-01 
1.8308E-01 
9.1370E-02 
2.9949E-01 
1.7313E-01 
6. 1255E-02 
2 . 0582E-01 
1.3081E-01 
7.4722E-02 
4 . 5479E-02 
3 . 9720E-02 
2.5367E-02 
-1.3761E-01 
-7.7551E-02 
-3.1760E-02 
-1. 1178E-01 
-1.4168E-01 
-7.7824E-02 
-3 . 2401E-01 
-1.2902E-01 
-9.5223E-02 
-3 . 5742E-01 
— 1.7364E— 01 
-8.8757E-02 
-2.3433E-01 
-1.1621E-01 
-4.8763E-02 


-3.7734E-01 
-1.8504E-01 
-9 . 5133E-02 
-2.8284E-01 
-1.5246E-01 
-7.4668E-02 
-1.5822E-01 
-3.7439E-02 
-2.6974E-02 
2.2481E-01 
1.1217E-01 
5.7285E-02 
3.6837E-01 


•3.4540E-02 
•5.0988E-02 
6. 5637E-03 
1.9258E-01 
1.0871E-01 
5.8910E-02 
3 . 3608E-01 
1.8014E-01 
9 . 0839E-02 
3.0025E-01 
1. 5026E-01 
7.4394E-02 
-6. 1085E-02 


1.8380E-01 -3.4382E-02 
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1.9943E+01 

2. 1614E+01 

2 . 1614E+01 

2. 1614E+01 

2.3286E+01 

2.3286E+01 

2.3286E+01 

2.4957E+01 

2 . 4957E+01 

2.4957E+01 

2.6629E+01 

2 . 6629E+01 

2 . 6629E+01 

2.8300E+01 

2.8300E+01 

2.8300E+01 

2.9971E+01 

2.9971E+01 

2.9971E+01 

3 . 1643E+01 

3 . 1643E+01 

3 . 1643E+01 

3.3314E+01 

3.3314E+01 

3.3314E+01 

3.4986E+01 

3.4986E+01 

3.4986E+01 

3 . 6657E+01 

3 . 6657E+01 

3 . 6657E+01 

3.8329E+01 

3.8329E+01 

3.8329E+01 

4 . OOOOE+Ol 

4 . OOOOE+Ol 

4. OOOOE+Ol 


1.8610E+00 
4.7185E-01 
4.7185E-01 
4.7185E-01 
-1. 3869E+00 
-1. 3869E+00 
-1. 3869E+00 
-1.7812E+00 
-1.7812E+00 
-1.7812E+00 
-3.2594E-01 
-3 . 2594E-01 
-3 . 2594E-01 
1.4421E+00 
1.4421E+00 
1.4421E+00 
1 . 6901E+00 
1 . 6901E+00 
1. 6901E+00 
1.8974E-01 
1.8974E-01 
1.8974E-01 
-1.4781E+00 
-1.4781E+00 
-1.4781E+00 
-1.5916E+00 
-1.5916E+00 
-1.5916E+00 
-6.5268E-02 
6.5268E-02 
6.5268E-02 
1.4970E+00 
1.4970E+00 
1.4970E+00 
1.4893E+00 
1.4893E+00 
1.4893E+00 


-4.7155E-01 
-1.8475E+00 
-1. 8475E+00 
-1.8475E+00 
-1.2884E+00 
-1.2884E+00 
-1.2884E+00 
5.9693E-01 
5.9693E-01 
5.9693E-01 
1.8347E+00 
1.8347E+00 
1.8347E+00 
1 . 1551E+00 
1 . 1551E+00 
1.1551E+00 
-7 . 0565E-01 
-7 . 0565E-01 
-7 . 0565E-01 
-1.8048E+00 
-1.8048E+00 
-1.8048E+00 
-1.0230E+00 
— 1.0230E+00 
-1.0230E+00 
7.9723E-01 
7.9723E-01 
7.9723E-01 
1.7611E+00 
1.7611E+00 
1.7611E+00 
8 . 9502E-01 
8.9502E-01 
8.9502E-01 
-8.7212E-01 
-8.7212E-01 
-8.7212E-01 


3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 

1 

2 

3 


9.1216E-02 
1.0911E-01 
4.0099E-02 
2.0366E-02 
-2.5132E-01 
-1 . 2542E-01 
-6 . 1509E-02 
-3.5324E-01 
-1.7609E-01 
-8.7505E-02 
-8 . 9997E-02 
-4 . 6848E-02 
-1.4011E-02 
2 . 6690E-01 
1.3238E-01 
6 . 4856E-02 
3.3526E-01 
1.6711E-01 
8.3234E-02 
4 . 9959E-02 
2 . 1814E-02 
8 . 0807E-03 
-2.7942E-01 
-1.4051E-01 
-6.7146E-02 
-3 . 1573E-01 
-1.5757E-01 
-7.8591E-02 
-1.9983E-02 
—8 . 1432E-03 
-2 . 6680E-03 
2.8223E-01 
1.4092E-01 
6.8416E-02 
2 . 9607E-01 
1.4794E-01 
7 . 3729E-02 


-2 . 1258E-02 
-3.5085E-01 
-1.7829E-01 
-9.0745E-02 
-2.6953E-01 
-1.3496E-01 
-6.8410E-02 
9.5945E-02 
5. 0354E-02 
2.7218E-02 
3 . 5150E-01 
1.7520E-01 
8.9818E-02 
2.4154E-01 
1.2181E-01 
6. 2118E-02 
-1.2302E-01 
-6.3096E-02 
-3.2460E-02 
-3 . 5060E-01 
-1.7575E-01 
-8.8172E-02 
-2.0948E-01 
-1.0339E-01 
-5 . 5897E-02 
1.4451E-01 
7 . 2957E-02 
3 . 6920E-02 
3.4369E-01 
1.7247E-01 
8.5946E-02 
1.8719E-01 
9.3133E-02 
5 . 0007E-02 
-1. 6029E-01 
-8 . 0328E-02 
-4 . 0632E-02 


SURF. ERR File 


Sample Run 


10:53AM 12-12-91 


jw = 
jw = 
jw = 
jw = 


3.0 after 20 iterations has error of 18.520% in LOX 
1= 3 J= 2 | G | = 2.2871E-03 |GOID|= 1.9298E-03 

33 3 after 20 iterations has error of 68.872% in LOX 
1= 1 J= 2 | G | = 2 . 0232E-02 |GOLD|= 1.198 IE-02 

36.7 after 20 iterations has error of 2.041% in LOX 
1= 4 J= 3 |G|= 6 . 6627E-02 |GOLD|= 6.5294E-02 

38.3 after 20 iterations has error of 456.116% in LOX 
1= 2 J= 3 | G | = 3 . 2994E-02 |GOLD|= 5.9329E-03 


line 

line 

line 

line 
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5.0 Flow Diagram 


MAIN 


- ENGNO 

FUEL 
LOX 


I— LPLOT — i 


■ — TANKNO 


r- RLTNE ~\ 


— FULDX MODIFY — 


I— RTYPE 
MOOTAN 

L_ ADMIT CIANH 


BENDS 


GINEKT 

ZREAD 


HI 


CSINH 

CCOSH 


|— UPPERW 
CURV 


\- FLPLOT 


FPLOT 
NYQUIS 
GEIKS 

I- ALLPT 


I— PNYQ 


MODENG 

modoon 


\- FLSECT H 


prppmr- 


HHSECT -\ 


BNSECT — 1 


STSECT 


TSSECT 


— GEIM 



ENDPLT 

SEIPLT 


fourcolors 


— WINDED 

— LABGAIN 

— WINDUP 
1— LABANG 
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6.0 Variable Description 

Variables in Commons 


xc 

YC 

RAD 

ANG 

ANGLE 

REAL*4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 

/ARCOON/ 

x coordinate of curve center 
y coordinate of curve center 
radius of bend 
angle of bend in radians 
angle of bend in degrees 

SCREEN 

CHAR*22 

/CCMMQQ/ 

screen atributes for plotting 

MENG 

TFLCW(25) 

PCHMB(25) 

DFROR(25) 

EWRAT(25) 

/ EPARAM/ 

INTEGER*2 number of engines 

rEAL* 4 total flow rate of engine (lbm/sec) 

REAL*4 chamber pressure (lbf/ft'2) 

REAL*4 pressure drop across orifices (lbf/ft 2) 

real* 4 chamber pressure/total mass flew 

SFAC 

REAL*4 

/FACTOR/ 

factor for frequency 


PIPE1F(75,25) 
PIPE2F(75, 25) 
PIPE3F(75,25) 
PIPE4F(75,25) 
PXPE5F(75,25) 


MLINEF 

SFLITF(25) 

AF(25) 

CMANF(25) 

CEANKF(25) 

DENSF(25) 

KMANF(25) 

KIANKF(25) 

LFLCWF(25) 

VOLF (25) 

VOLMFF(25) 

AREAF(75,25) 

DIAF(75,25) 

LF(75,25) 

PINDF(75,25) 

PCAPF(75,25) 

AVGKF(25) 

SEGMNF(25) 

SECINF(75,25) 

NOLINF(25) 

IENGF(25) 


/FOPIPE/ 

REAL*4 first parameter of pipe description 
rEAL* 4 second parameter of pipe description 
rEAL* 4 third parameter of pipe description 
REAL * 4 fourth parameter of pipe description 

REAL*4 fifth parameter of pipe description 

/FPARAM/ 

INTEGER*? number of lines frcsn tank 

REAL*4 number of unique lines from pipe split 

REAL*4 speed of sound in the fluid (ft/s ec) 

REAL* 4 manifold capacitance 

REAL*4 tank capacitance 

REAL*4 density of fluid (ltm/ft‘3) 

REAL*4 bulk modulus of manifold (lbf/ft'2) 
real* 4 bulk modulus of tank (lbf/ft*2) 
rEAL* 4 flow rate throu^i pipe (lbm/sec) 

REAL*4 volume of tank (ft' 3) 

REAL*4 volume of manifold (ft~ 3 ) 

REAL* 4 area of pipe section (ft'2) 

REAL*4 diameter of pipe section (ft) 

REAL*4 length of pipe section (ft) 

REAL*4 inductance of pipe section 
REAL* 4 capacitance of pipe section 
REAL* 4 average bulk modulus 
INTEGER* 2 number of pipe sections 
INTEGER*2 pipe section type 
INTEGER* 2 number of identical lines 
INTEGER* 2 engine number 
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ITANKF(25) 

IDPOLF(25) 

IDPENF(25) 


NOOLS 

NMQDE 


MLINED 

SPLITO(25) 

AD(25) 

CMANO(25) 

CIANKO(25) 

DENSO (25) 

KMANO(25) 

KIANKO(25) 

LFIOWO(25) 

VOID (25) 

VOLMPO(25) 

AREAO(75,25) 

DIAO(75,25) 

ID (75,25) 

PINDO(75, 25) 

PCAPO(75,25) 

AVGKO(25) 

SEQ1N0(25) 

SECINO(75,25) 

NOLINO(25) 

IENGO(25) 

ITANKO(25) 

LDPOLO(25) 

IDPENO(25) 


X 

XH 

XL 

Y 

YH 

YL 

XMIN 

XMAX 

YMIN 

YMAX 

SINA 

COSA 


PIPE1(150) 
PIPE2 (150) 
PIPES (150) 
P3PE4 (150) 


INTEGER* 2 tank number 

INTEGER* 2 previous maximum number of iterations 
TNTEGER*2 maximum number of iterations for split pipe 


/NOCOL/ 

INTEGER* 2 number of text columns 
INTEGER* 2 graphics mode 

/OPARAM/ 

INTEGER*2 number of lines from tank 

real* 4 number of unique lines from pipe split 

REAL*4 speed of sound in the fluid (ft/sec) 

REAL*4 manifold capacitance 

REAL* 4 tank capacitance 

REAL* 4 density of fluid (11m/ ft *3) 

REAL*4 bulk modulus of manifold (Ibf/ft 2) 

REAL*4 bulk modulus of tank (lbf /ft'2) 

REAL*4 flew rate through pipe (11m/ sec) 

REAL* 4 volume of tank (ft~3) 

REAL* 4 volume of manifold (ft'3)^ 

REAL*4 area of pipe section (ft"2) 

REAL*4 diameter of pipe section (ft) 

REAL*4 length of pipe section (ft) 

REAL* 4 inductance of pipe section 

REAL* 4 capacitance of pipe section 

REAL*4 average bulk modulus 
INTEGER* 2 number of pipe sections 
INTEGER* 2 pipe section type 
INTEGER* 2 number of identical lines 
INTEGER*2 engine number 
INTEGER*2 tank number 

INTEGER*2 previous maximum number of iterations 
INTEGER* 2 maximum number of iterations for split pipe 

/PIFFXY/ 

REAL*4 x location of current centerline 

REAL*4 x location of current upper pipe 

REAL*4 x location of current lower pipe 

real* 4 y location of current centerline 

REAL* 4 y location of current upper pipe 

REAL*4 y location of current lower pipe 

REAL*4 minimum x value of piping layout 

REAL* 4 maximum x value of piping layout 

REAL*4 minimum y value of piping layout 

REAL*4 maximum y value of piping layout 

REAL*4 sine of current pipe direction 
real* 4 cosine of current pipe direction 

/SETUP/ . . 

real* 4 current first parameter of pipe description 

real* 4 current second parameter of pipe description 

real* 4 current third parameter of pipe description 

real* 4 current fourth parameter of pipe description 
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NENGF(25) 

NTANKF(25) 

NLINEF(25) 

NSPF(25) 

TT.TN FF 

NENGO(25) 

NIANKO(25) 

NLTNBO(25) 

NSPO(25) 

ILINBD 

SEGMN 

SECIN (150) 


MEANK 


INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER*2 
IN TEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 


engine for a fuel line 

tank for a fuel line 

section number for a fuel line 

starting fuel line number 

current fuel line 

engine for a lox line 

tank for a lox line 

section number for a lox line 

starting lox line number 

current lox line 

current number of pipe sections 

current pipe section type 


/ TANK/ 

INTEGER* 2 number of tanks 


NAMLIN(2) 


title 

TTTLF 

IHR 

HON 

AP 

IYR 

IMON 

IDAY 


K1R(1001) 

K1C(1001) 

K2R(1001) 

K2C(1001) 

K3R(1001) 

K3C(1001) 

K4R(1001) 

K4C(1001) 

DUMMY1(3392) 

DUMMY2 (8397) 

X(1001) 

YR(1001) 

YC(1001) 

G(0:75,25) 

ZT(0:75,25) 

ZG(0:75,25) 


ZO(75,25) 
POINTS, 200) 
DUMMY3 (175) 
ITYPE(200) 


/WCAOUT/ _ . , 

CHAR*24 name of files containing pipe description 


/ WCATIT/ 

CHAR*40 title for plots 
CHAR*20 title from pipe file 
INTEGER* 2 hour code run 
INTEGER* 2 minute code run 
CHAR* 2 AM or PM 
INTEGER* 2 yesr code run 
INTEGER* 2 month code run 
INTEGER* 2 day code run 


/WOEK1/ 

REAL*4 real part of K(jw) 

REAL*4 complex part of K(jw) 

REAL*4 real part of K(jw,GOX) 

REAL*4 complex part of K(jw,GOX) 

REAL*4 real part of K(jw,GF) 

REAL*4 complex part of K(jw,GF) 

REAL*4 real part of K(jw,GOX,GF) 

REAL* 4 complex part of K(jw,GOX,GF) 
REAL* 4 dummy array for spacing 

REAL*4 dummy array for spacing 

REAL* 4 frequency array 

REAL* 4 real part of Nyquist 

REAL*4 complex part of Nyquist 

C0MPLEX*8 admittance looking toward tank 
COMPLEX* 8 impedance looking toward tank 
C0MPLEX*8 impedance looking toward engine 


REAL*4 
REAL*4 
REAL* 4 
TNTEGER*2 


/W0RK2/ 

characteristic impedance 
description of plot element 
dummy array for spacing 
type plot element 
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PROGRAM NYQ 

Logic portion of code 


Commons EPARAM FACTOR FPARAM NOCOL OPARAM SETUP WCAOUT 
WCATTT WORK1 

Local Variables 


AM 

ANS 

ANSI 

CSTAR(25) 

DCDR(25) 

GF(25) 

GOX(25) 

HFRBQ 

I 

IFUEL 

IGONE 

ILOX 

ISEC 

1100 

J 

JUNTT 

K 

KW(1001) 

LFREQ 

NAMENG 

NOXY 

NOXYP 

NPTS 

PM 

PTS 

RBAR(25) 

S 

SSIZE1 

SSIZE2 

SSIZE3 

TAUT (25) 

THEIAC(25) 

VARI 

W 


CHAR* 2 

CHAR*1 

CHAR* 2 

REAL*4 

REAL*4 

CCMPLEX*8 

OCMPLEX*8 

REAL* 4 

INTEGER* 2 

INTEGER* 2 

INTEGER* 2 

INTEGER* 2 

INTEGER* 2 

INTEGER* 2 

INTEGER* 2 

INTEGER* 2 

INTEGER*2 

REAL*4 

REAL*4 

CHAR*24 

INTEGER* 2 

INTEGER* 2 

INTEGER* 2 

CHAR* 2 

INTEGER* 2 

REAL*4 

OCMPLEX*8 

REAL*4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 

CHAR*24 

REALM 


'AM' 

response to question 
response to question 

characteristic rocket velocity (ft/ sec) 
change in velocity with mixture ratio (ft/sec) 
admittance of fuel line looking toward tank 
adm ittance of lox line looking toward tank 
maximum frequency requested 
do loop index 

flag indicating presence of fuel line 

flag for FUEL & LOX routines 

flag indicating presence of lox line 

second code run 

hundredth of second code run 

do loop index 

unit number of engine data file 

do loop index 

frequency array 

minimum frequency requested 

name of engine d at a file 

counter 

pointer 

flag to switch step size 
'PM' 

number of frequencies 
mixture ratio 
complex frequency 

to pack frequencies toward low end 
parameter to pack frequencies toward low end 
parameter to pack frequencies toward low end 
transport lag (sec) 
characteristic time constant (sec) 
name of input file 
oscillatory part of frequency 


SUBROUTINE ALLFT 

Supervises Nyquist plot 


Commons NOCOL 

GHOLD(lOOl) 

ING 

ITF 

no 

HYPE 

PTS 


Variables in Argument List 
REAL* 4 complex part of K() 

INTEGER* 2 engine number 
INTEGER*2 fuel tank number 
INTEGER* 2 lox tank number 
INTEGER* 2 which K() 

INTEGER* 2 number of values to plot 
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WHOLD(lOOl) 

REAL* 4 

real part of K() 


Local Variables 

DUMWIL 

INTEGER* 2 

intermediate variable 

ENCalWK 

CHAR*38 

intermediate variable 

I 

INTEGER* 2 

do loop index 

IMAX 

REAL* 8 

maximum value of complex part 

TMMTN 

REAL*8 

minimum value of complex part 

KMAX 

REAL* 8 

maximum value of real part 

EMIN 

REAL*8 

minimum value of real part 

s 

CHAR* 4 

intermediate variable 

X 

REAL* 8 

x value of point to be plotted 

XY 

CHAR*16 

intermediate variable 

Y 

REAL*8 

y value of point to be plotted 


SUBROUTINE CUKV 

Draws circular arc 


Variables in Argument List 
REAL*8 starting angle for arc 
REAL* 8 ending angle for arc 
Local Variables 

REAL*4 starting angle for arc 

REAL*4 ending angle for arc 

REAL*4 incremental angle for plot 

REAL* 4 total angle to plot 

INTEGER* 2 intermediate variable 

INTBGER*2 do loop index 

INTEGER* 2 number of points to plot 

REAL*4 current angle 

REAL*8 x location of point to plot 

CHAR*16 intermediate variable 

REAL* 8 y location of point to plot 


SUBROUTINE ENDPLT 

Closes plot routines 

Local Variables 

DUMMY INTEGER* 2 intermediate variable 


SUBROUTINE FLPLOT 

Supervises plot of piping 

POPIPE FPARAM OPARAM SETUP 
Variables in Argument List 
INTEGER* 2 flag indicating presence of lox line 
Local Variables 
INTBGER*2 do loop index 
INTEGER* 2 fuel line pointer 
INTEGER* 2 fuel line plot pointer 
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Commons EPARAM 

HOX 

I 

IPF 

IPIOTF 


Commons ARCCON 

A1 

A2 

ANG1 

ANG2 

DA 

DIH 

DUMWIL 

I 

N 

T 

XP 

XY 

YP 


IPL0TO 

INTEGER*2 

lox line plot pointer 

IPO 

INTEGER* 2 

lox line pointer 

J 

INTEGER* 2 

do loop index 

K 

INTEGER* 2 

pointer 

L 

INTEGER* 2 

do loop index 

NOXY 

INTEGER* 2 

intermediate variable 

NOXYP 

INTBGER*2 

intermediate variable 

LOGICAL FUNCTION fourcolors 

Determines type of graphics monitor 


Caramons OOMMQQ 

Local Variables 

DUMMY INTEGER*2 intermediate variable 


SUBROUTINE FPLDT 

Determines fuel line to be plotted 


Commons EPARAM 

nox 

i 

IPF 

IPL0TF 

J 

K 

L 


POPIPE EPARAM SEIUP 
Variables in Argument List 
INTEGER*2 flag indicating presence of lox line 


Local Variables 
INTECER*2 do loop index 
H7TEGER*2 fuel line pointer 
INTEGER* 2 fuel line plot pointer 
INTEGER* 2 pointer 
INTEGER* 2 pointer 
INTEGER* 2 do loop index 


SUBROUTINE LABANG 

Labels phase angle plot 

Caramons OOMMQQ FACTOR NOCOL WCA3TT 

Variables in Argument List 


XMAX 

REAL*8 

maximum x value for phase 

angle plot 

XMIN 

REAL*8 

minimum x value for phase 

angle plot 

YMAX 

REAL*8 

maximum y value for phase 

angle plot 

YMIN 

REAL*8 

minimum y value for phase 

angle plot 


Local Variables 


DUMMY 

REAL*4 

intermediate variable 


DUMWIL 

INTBGER*2 

intermediate variable 


HI 

REAL*4 

intermediate variable 


I 

INTEGER* 2 

do loop index 


IDEL 

INTEGER* 2 

intermediate variable 


IHI 

INTEGER* 2 

intermediate variable 


no 

INTBGER*2 

intermediate variable 


HOC 

INTEGER* 2 

intermediate variable 


IMAX 

INTEGER* 2 

intermediate variable 


ROW 

INTEGER* 2 

intermediate variable 


ROWS 

INTEGER* 2 

intermediate variable 
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s 

XHI 

XP 

XY 

YHI 

YLD 

YP 


CHAR* 4 intermediate variable 

CHAR* 7 label for x tick marks 

REAL*8 x point for plot. 

CHAR* 16 intermediate variable 

CHAR* 6 ' 180° ' upper phase angle label 

CHAR* 6 ' -180°' lower phase angle label 

REAL*8 y point for plot 


SUBROUTINE LABGAIN 
Labels gain plot 


Commons OOMMQQ FACTOR NOCOL WCATIT 

Variables in Argument List 


itype 

XMAX 

XMIN 

YMAX 

YMIN 

DUMMY 

DUMWXL 

HI 

I 

IDEL 

IHI 

mo 

moc 

IMAX 

ROW 

ROWS 

S 

XHI 

XP 

XY 

YHI 

YLO 

YP 


INTEGER* 2 which K() 

real* 8 maximum x value for gain plot 

REAL* 8 minimum x value for gain plot 

REAL*8 maximum y value for gain plot 

REAL*8 minimum y value for gain plot 

Local Variables 

rEAL* 4 intermediate variable 

INTEGER*2 intermediate variable 

REAL*4 intermediate variable 

INTEGER* 2 do loop index 

INTEGER*2 intermediate variable 

INTEGER* 2 intermediate variable 

INT EG ER*?- intermediate variable 

INTEGER*2 intermediate variable 

INTEGER* 2 intermediate variable 

INTEGER* 2 intermediate variable 

INTEGER* 2 intermediate variable 

CHAR* 4 intermediate variable 

CHAR* 7 label for x tick marks 

REAL*8 x point for plot 

CHAR* 16 intermediate variable 

CHAR* 6 1 180° ' upper phase angle label 

CHAR* 6 ' -180°' lower phase angle label 

REAL*8 y point for plot 


SUBROUTINE LOWERW 

Sets up lower plotting window 

Commons GCMMQQ NOCOL 

Variables in Argument List 

XMAX REAL* 8 maximum x value for Nyquist plot 

XMIN REAL* 8 minimum x value for Nyquist plot 

YMAX REAL*8 maximum y value for Nyquist plot 

YMIN real* 8 minimum y value for Nyquist plot 

Local Variables 

INTEGER*? number of text columns 
INTEGER*2 intermediate variable 
INTEGER* 2 number of text rows 


COLS 

DUMMY 

ROWS 
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XLEN 

xwieth 

YHEKS-TT 

YLEN 


REAL* 8 
INTEGER*2 
INTEGER* 2 
REAL* 8 


intermediate variable 
number of x pixels 
number of y pixels 
intermediate variable 


SUBROUTINE LPIOT 

Determines lox line to be plotted 


ILOX 


Commons EPARAM FOPIPE OPARAM SETUP _ 

Variables in Argument List 
INTEGER* 2 flag indicating presence of lox line 

Local Variables 
INTEGER* 2 do loop index 
INTEGER* 2 lox line plot pointer 
INTEGER*2 lox line pointer 
INTEGER* 2 pointer 
INTEGER* 2 pointer 
INTEGER* 2 do loop index 


I 

IPLOTO 

IPO 

J 

K 

L 


SUBROUTINE NICBGRF 

Plots Nyquist curve 


Commons 00MM2Q FACTOR NOOOL WCATIT 

Variables in Argument List 


IMAX 

IMMIN 

ITYPE 

RMAX 

RMIN 


REAL*8 
REAL* 8 
INTEGER* 2 
REAL*8 
REAL* 8 


maximum value of 
minimum value of 
which K() 
maximum value of 
minimum value of 


complex part 
complex part 

real part 
real part 


Local Variables 

intermediate variable 


DUMMY 

REAL*4 

ROW 

INTEGER* 2 

ROWS 

INTEGER* 2 

S 

CHAR* 4 

XHI 

CHAR* 6 

XLD 

CHAR* 6 

XMAX 

REAL* 8 

XMIN 

REAL*8 

YHI 

CHAR* 6 

YLO 

CHAR* 6 

YMAX 

REAL* 8 

YMIN 

REAL* 8 


intermediate variable 
intermediate variable 
intermediate variable 
label for maximum x value 
label for minimum x value 
maximum x value 
minimum x value 
label for maximum y value 
label for minimum y value 
maximum y value 
minimum y value 


SUBROUTINE PIPPLOT 

Supervises plot of piping layout 

Commons ARCCON PIPPXY W0RK2 

Variables in Argument List 
INTEGER* 2 engine number 
INTEGER* 2 flag for fuel or lox 


IING 

ILOX 
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ITANK 
PXPE1(75) 
PIPE2 (75) 
PIPE3 (75) 
PXPE4 (75) 
R 

SECIN(75) 

SEGMN 

DUMWIL 

I 

J 

XRANGE 

XO 

XI 

X2 

X3 

YRANGE 

YO 

Y1 

Y2 

Y3 


INTEGER* 2 tank number 

REAL*4 first parameter of pipe description 
real* 4 second parameter of pipe description 
REAL*4 third parameter of pipe description 
rEAL* 4 fourth parameter of pipe description 
CHAR*1 flag for fuel or lox 
INTEGER* 2 pipe section type 
INTEGER* 2 number of pipe sections 
Local Variables 

INIEGER*2 intermediate variable 
INTEGER* 2 do loop index 
INTEGER* 2 do loop index 
REAL*4 range of x values 
real* 4 intermediate variable 
REAL*4 intermediate variable 
REAL*4 intermediate variable 
REAL*4 intermediate variable 
REAL*4 range of y values 
REAL* 4 intermediate variable 
rEAL* 4 intermediate variable 
REAL* 4 intermediate variable 
REAL* 4 intermediate variable 


SUBROUTINE PLSECT 

Computes plot coordinates for parallel resonator 


Commons ARCCON 
DIA 

ITYPE(200) 

J 

LEN 

POINT(8,200) 

VOL 

ANGOID 

ANGSAV 

COSOID 

DIM 

PDIA 

PLEN 

RADIUS 

SIDE 

SINOID 

TORN 

XHC 

XHOLD 

XHSAV 

XLC 

XLDLD 

XLSAV 

XOID 


PIPPXY 

Variables in Argument List 
REAL* 4 diameter of parallel segment (ft) 
INT EG ER*?- type plot element 
INTEGER*? pointer to element 
REAL*4 length of parallel segment (ft) 
REAL*4 description of plot element 
REAL*4 volume of bypassed segment (ft'3) 

Local Variables 

REAL* 4 intermediate variable 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

REAL* 4 intermediate variable 

REAL* 4 intermediate variable 

REAL*4 intermediate variable 

REAL* 4 intermediate variable 

PEAL* 4 intermediate variable 

rEAL* 4 intermediate variable 

REAL* 4 intermediate variable 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

PEAL* 4 intermediate variable 

REAL* 4 intermediate variable 

rEAL* 4 intermediate variable 

REAL* 4 intermediate variable 
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REAL* 4 intermediate variable 
REAL* 4 intermediate variable 
REAL* 4 intermediate variable 
REAL* 4 intermediate variable 
REAL* 4 intermediate variable 
REAL* 4 intermediate variable 
real* 4 intermediate variable 
REAL* 4 intermediate variable 
REAL*4 intermediate variable 


SUBROUTINE PNYQ 

Plots gain and phase angle 

Commons OOMMQQ NOCOL W0RK1 


ING 

Variables in Argument List 
INTEGER*2 engine number 

itf 

INTEGER* 2 

fuel tank number 

rro 

INTEGER* 2 

lox tank number 

ITYPE 

INTEGER* 2 

type plot element 

KC(PTS) 

REAL* 4 

complex part of K() 

KR(PTS) 

REAL*4 

real part of K() 

KW(PTS) 

REAL*4 

frequency 

PTS 

INTEGER* 2 

number of points 

DUMWIL 

Local Variables 

INTEGER*2 intermediate variable 

ENGTINK 

CHAR*38 

intermediate variable 

I 

INTEGER* 2 

do loop index 

ROWS 

REAL*4 

intermediate variable 

s 

CHAR* 4 

intermediate variable 

xm 

REAL* 8 

intermediate variable 

XLO 

REAL* 8 

intermediate variable 

XMAX 

REAL*8 

maximum x value 

XMIN 

REAL*8 

minimum x value 

XP 

REAL* 8 

x point to plot 

XY 

CHAR* 16 

intermediate variable 

YMAXC 

REAL* 8 

maximum phase angle 

YMAXR 

REAL*8 

maximum amplitude 

YMINC 

REAL*8 

minimum phase angle 

YMINR 

REAL* 8 

minimum amplitude 

YP 

REAL* 8 

y point to plot 

SUBROUTINE SETPLT 



Sets up the plot environment 
Commons OOMMQQ NOCOL WCAPAS 


XSAV 

YHC 

YHOLD 

YHSAV 

YLC 

YLOLD 

YLSAV 

YOLD 

YSAV 


SUBROUTINE UPPERW 

Sets up upper plotting window 

Commons OOMMQQ NOCOL WCATIT 
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IENG 

hdx 

ITANK 

R 

XOO 

Xll 

YOO 

Yll 

ADDX 

ADDY 

OOLS 

DUMMY 

FULOX 

HALFY 

PICX 

PICY 

RCWS 

S 

XRANG 

XRAT 

XWIDIH 

XO 

XI 

YHEIGHT 

YRANG 

YRAT 

YO 

Y1 


Variables in Argument List 
INTEGER* 2 engine number 

INTEGER* 2 flag indicating presence of lox line 

INTEGER*2 tank number 

CHAR*1 flag for fuel of lox 

rEAL* 4 minimum value of x for piping layout window 

PEal *4 maximum value of x for piping layout window 

REAL*4 minimum value of y for piping layout window 

REAL * 4 maximum value of y for piping layout window 

Local Variables 

rEAL* 4 intermediate variable 

REAL*4 intermediate variable 

INTEGER* 2 number of text columns 
INTEGER* 2 intermediate variable 

CHAR*36 plot identification 
REAL* 4 intermediate variable 

REAL* 4 intermediate variable 

real* 4 intermediate variable 

INTEGER* 2 number of text rows 

CHAR*4 intermediate variable 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

INTEGER*2 number ox x pixels 
REAL *8 minimum x value 

REAL* 8 maximum x value 

INTEGER* 2 number of y pixels 
REAL*4 intermediate variable 

REAL* 4 intermediate variable 

REAL* 8 minimum y value 

REAL* 8 maximum y value 


SUBROUTINE WINDLO(XMIN,XMAX, YMIN, YMAX) 
Sets 15 ) gain window 


Commons OOMMQQ 

XMAX 

XMIN 

YMAX 

YMIN 

OOLS 

DUMMY 

HALFY 

RCWS 

XLEN 

XMAXP 

XMINP 

XWIDIH 

YHEIGHT 

YLEN 

YMAXP 


NOCOL 

Variables in Argument List 
REAL* 8 maximum x value 
REAL* 8 minimum x value 
REAL *8 maximum y value 
REAL *8 minimum y value 

Local Variables 

INTEGER* 2 number of text columns 
INTEGER* 2 intermediate variable 
INTEGER*2 intermediate variable 
INTEGER* 2 number of text rows 
REAL* 8 intermediate variable 
REAL* 8 maximum x value 
REAL * 8 minimum x value 
INTEGER* 2 number of x pixels 
INTEGER* 2 number of y pixels 
REAL * 8 intermediate variable 
REAL* 8 maximum y value 
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YMiNP REAL* 8 minimum y value 


SUBROUTINE WINDUP 

Sets up phase angle window 


Commons OCMMQQ 

NOCOL 



variables in Argument List 

XMAX 

REAL* 8 

maximum x value 

XMIN 

REAL* 8 

minimum x value 

YMAX 

REAL*8 

maximum y value 

YMIN 

REAL*8 

minimum y value 


Local Variables 

COLS 

INTEGER*2 

number of text columns 

DUMMY 

INTEGER*2 

intermediate variable 

HALFY 

INTEGER* 2 

intermediate variable 

ROWS 

INTEGER* 2 

number of text rows 

XLEN 

REAL* 8 

intermediate variable 

XMAXP 

REAL* 8 

maximum x value 

XMINP 

REAL* 8 

minimum x value 

XWIDIH 

INTEGER* 2 

number of x pixels 

YHEIGNT 

INTEGER* 2 

number of y pixels 

YLEN 

REAL*8 

intermediate variable 

YMAXP 

REAL*8 

maximum y value 

YMINP 

REAL*8 

minimum y value 


SUBROUTINE ADMIT 

Determines admittance looking toward tank 


Commons FACTOR WCATTT W0RK1 W0RK2 

Variables in Argument List 


A 

REAL*4 

speed of sound in the fluid (ft/sec) 

AREA(75,25) 

REAL*4 

area of pipe section (ft~2) 

CMAN(25) 

REAL*4 

manifold capacitance 

CIANK 

REAL*4 

tank capacitance 

DPROR(25) 

REAL* 4 

pressure drop across orifices (lbf/ft 2) 

GADM(25) 

COMPLEX* 8 

admittance looking toward tank 

IENG(25) 

INTEGER* 2 

engine number 

LLINE 

INTEGER* 2 

line number 

IP 

INTEGER* 2 

current pipe section 

rniN 

INTEGER*2 

flag for fuel or lox 

L(75, 25) 

REAL*4 

length of pipe section (ft) 

LFICW 

REAL*4 

flow rate through pipe (ltm/sec) 

LOPEND 

INTEGER* 2 

maximum number of iterations for split pipe 

NOLINE (25) 

INTEGER* 2 

number of identical lines 

PCAP(75, 25) 

REAL*4 

capacitance of pipe section 

PIND(75, 25) 

REAL* 4 

inductance of pipe section 

FMRAT(25) 

REAL* 4 

chamber pressure/ tota 1 mass flew 

S 

COMPLEX* 8 

current frequency 

SECTN(75,25) 

INTEGER* 2 

pipe section type 

SECMN(25) 

INTEGER* 2 

number of pipe sections 

SPLIT 

REAL*4 

number of unique lines from pipe split 
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TF1£W(25) 


CAEM 

CAPN 

CFAC 

EPRP 

GDIF 

GOLD(0:75,25) 

GRAV 

I 

IE 

IOPEN 

IWG 

J 

JW3 

K 

KLOOP 

LDPHI 

RATFM 

FHS 

TOOUNT 

TL 

TMASS 

TYPEL(2) 

WG 

WGOID 

ZGEFF 

ZLP 

ZOEFF 

ZOR(25) 

ZTEFF 

ZTOP 


PEAL* 4 total flow rate of engine (Urn/ sec) 

Local Variables 

C0MPLEX*8 intermediate variable 

COMPLEX* 8 intermediate variable 

COMPLEX* 8 intermediate variable 

REAL* 4 convergence error 

PEAL* 4 maximum difference in admittance 

COMPLEX* 8 previous addmittance 

PEAL* 4 gravitational constant ( lfcm- ft/ lbf-sec 2) 

INTEGER* 2 do loop index 

INTEGER*? current engine number 

INTEGER*2 flag indicating if SURF . ERR is open 

INTEGER* 2 first index of maximum error 

INTEGER* 2 do loop index 

INTEGER* 2 second index of maximum error 

INTEGER* 2 do loop index 

INTEGER* 2 do loop index 

INTEGER* 2 intermediate variable 

rEAL* 4 intermediate variable 

CCMPLEX*8 intermediate variable 

REAL*4 intermediate variable 

REAL* 4 length/speed of sound 

REAL*4 intermediate variable 

CHAR* 13 intermediate array 

real* 4 intermediate variable 

REAL* 4 intermediate variable 

CCMPLEX*8 effective impedance for calculations 

REAL* 4 intermediate variable 

REAL* 4 effective ZO for calculations 

REAL*4 intermediate variable 

CCMPLEX*8 effective Zt fear calculations 

PEAL* 4 intermediate variable 



SUBROUTINE BNSECT 

Conputes plot coordinates for a bend 
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Commons ARCCON 

ITYPE(200) 

J 

PIPE1 

PHPE2 

PIPE3 

PIPE4 

POINT (8, 200) 

DIA 

HOLD 

RANG 

SLENIH 

XO 

XI 

X2 

X3 

YO 

Y1 

Y2 

Y3 


PIPPXY 

Variables in Argument List 
INTEGER* 2 type plot element 
INTEGER* 2 pointer to element 
REAL*4 first parameter of pipe description 
REAL* 4 second parameter of pipe description 
REAL* 4 third parameter of pipe description 

REAL*4 fourth parameter of pipe description 
REAL*4 description of plot element 

Local Variables 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

REAL* 4 intermediate variable 

REAL*4 intermediate variable 

REAL* 4 intermediate variable 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

REAL*4 intermediate variable 

REAL* 4 intermediate variable 

REAL*4 intermediate variable 

REAL* 4 intermediate variable 


O0MPLEX FUNCTION COOSH 

Evaluates the complex hyperbolic cosine 

Variables in Argument List 
S C0MPLEX*8 current frequency 

Local Variables 

O0SHI REAL*4 intermediate variable 

OOSHR REAL* 4 intermediate variable 

IAMDA REAL*4 real part of complex frequency 

MU REAL*4 complex part of conplex frequency 


O0MPLEX FUNCTION CSINH 

Evaluates the conplex hyperbolic sine 

Variables in Argument List 
S C0MPLEX*8 current frequency 

Local Variables 

IAMDA REALM real part of conplex frequency 

MU REAL*4 complex part of complex frequency 

SINHI REAL* 4 intermediate variable 

SINHR REAL* 4 intermediate variable 


COMPLEX FUNCTION CIANH 

Evaluates the complex hyperbolic tangent 

Variables in Argument List 
S 0CMPLEX*8 current frequency 
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SUBROUTINE ENGNO 

Reads engine parameters 

Commons EPARAM 

IUNIT 

I 


SUBROUTINE FUEL 

Handles fuel piping logic 

FOPIPE FPARAM WCAOUT 
Variables in Argument List 
COMPLEX* 8 admittance looking toward tank 
INTEGER* 2 flag for subroutine fuel or lox 
INTEGER* 2 unit number of fuel data file 
INTEGER* 2 unit number of fuel work file 
COMPLEX* 8 current frequency 
Local Variables 

CHAR*1 response to question 

CHAR*24 name of fuel data file 


SUBROUTINE FULOX _ ^ - 

Handles read, modify, and admittance calls for fuel and lox 


Variables in Argument List 
REAL*4 speed of sound in the fluid (ft/ sec) 

REAL*4 area of pipe section (ft‘2) 

REAL*4 average bulk modulus 
REAL*4 manifold capacitance 
REAL*4 tank capacitance 
REAL* 4 density of fluid (lim/ft‘3) 

REAL*4 diameter of pipe section (ft) 

C0MPLEX*8 admittance looking toward tank 
INTEGER* 2 engine number 

INTEGER* 2 flag for subroutine fuel or lox 
INTEGER* 2 tank number 
INTEGER*2 flag indication fuel or lox 
INTEGER* 2 unit number of piping data file 
INTEGER* 2 unit number of working file 
REAL* 4 bulk modulus of manifold (lbf/ft 2) 

REAL*4 bulk modulus of tank (lbf/ft'2) 

REAL*4 length of pipe section (ft) 

REAL* 4 flew rate through pipe (11m/ sec) 

INTEGER*2 maximum number of iterations for split pipe 
INTEGER* 2 previous maximum number of iterations 
INTEGER* 2 number of lines from tank 
INTEGER* 2 number of identical lines 
REAL*4 capacitance of pipe section 


Commons EPARAM 
A(25) 

AREA(75,25) 

AVGK(25) 

CMAN(25) 

CIANK(25) 

DENS (25) 

DIA(75,25) 

GF(25) 

IENG(25) 

IGONE 

ITANK(25) 

nuN 

IUNIT 

IUNITP 

KMAN(25) 

KIANK(25) 

L(75, 25) 

LFL£W(25) 

IOPEND(25) 

ICPOID(25) 

MLINE 

NOLINE (25) 

PCAP(75,25) 


Commons EPARAM 

GF(25) 

IGONE 

IUNIT 

IUNITP 

S 

ANS 

FUEUN 


Variables in Argument List 
INTEGER*2 unit number of engine file 
Local Variables 
INTEGER* 2 do loop index 
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PIND(75, 25) 
PIPE1(75,25) 
PIPE2 (75,25) 
PIPE3 (75,25) 
PIPE4 (75,25) 
PIPE5 (75,25) 
S 

SECIN(75,25) 
SEGMN(25) 
SPLTT(25) 
VOL (25) 
VOIMF(25) 

ANS 

I 

TTiTNE 

IP 

IT 

QUEST1(2) 
QUEST2 (2) 
QUEST3 (2) 
TITL 


REAL*4 inductance of pipe section 

REAL* 4 first parameter of pipe description 

REAL* 4 second parameter of pipe description 

REAL* 4 third parameter of pipe description 

rEAL* 4 fourth parameter of pipe description 

REAL* 4 fifth parameter of pipe description 

OOMPLEX*8 current frequency 

INTEGER* 2 pipe section type 

INTEGER*2 number of pipe sections 

rEAL* 4 number of unique lines from pipe split 

REAL*4 volume of tank (ft‘3) 

REAL*4 volume of manifold (ft‘3) 

Local Variables 

CHAR*1 response to question 

INTEGER* 2 do loop index 
INTEGER* 2 current line number 
INTEGER* 2 current segment number 
INTEGER* 2 current tank number 
CHAR*40 question array 

CHAR*48 question array 

CHAR*40 question array 

CHAR*20 title from data file 


SUBROUTINE GEIKS 

Determines Nyquist equation to be plotted 


Variables in Argument List 
I INTEGER* 2 fuel line number 

j INTEGER* 2 lox line number 

K INTEGER* 2 engine number 

KlC(lOOl) REAL* 4 complex part of K(jw) 

KlR(lOOl) REAL*4 real part of K(jw) 

K2C(1001) REAL*4 complex part of K(jw,GOX) 

K2R(1001) REAL*4 real part of K(jw,GOX) 

K3C(1001) REAL*4 complex part of K(jw,GF) 

K3R(1001) REAL*4 real part of K(jw,GF) 

K4C(1001) REAL*4 complex part of K(jw,GOX,GF) 

K4R(1001) REAL*4 real part of K(jw,GOX,GF) 

N INTEGER* 2 number of points 

Local Variables 

C1K(25) REAL* 4 work array for complex part of K(jw) 

C 2 K( 25 ) REAL*4 work array for complex part of K(jw,GOX) 

C3K(25) REAL*4 work array for complex part of K(jw,GF) 

C4K(25) REAL*4 work array for complex part of K(jw,GOX,GF) 

L INTEGER* 2 do loop index 

M INTEGER* 2 pointer 

R1K(25) REAL*4 work array for real part of K(jw) 

R2K(25) REAL*4 work array for real part of K(jw,GOX) 

R3K(25) REAL*4 work array for real part of K(jw,GF) 

R4K(25) REAL*4 work array for real part of K(jw,GOX,GF) 
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SUBROUTINE GETM 

Determines location of data to be plotted 


Commons SETUP 

Variables in Argument List 


I 

INTEGER*2 

fuel line pointer 

J 

INTEGER* 2 

lox line pointer 

M 

INTEGER* 2 

plot pointer 


Local Variables 

II 

INTEGER* 2 

do loop index 

JJ 

INTEGER* 2 

do loop index 


SUBROUTINE G INERT 

Evaluates curve fit of inertance of bends 

Variables in Argument List 
REAL*4 angle of bend (degrees) 

PEAL* 4 ratio of inner to outer radius 

REAL*4 inertance 

Local Variables 

rEAL* 4 intermediate variable 

REAL*4 coefficient array for inertance fit 


SUBROUTINE HHSECT 

Computes plot coordinates for Helmholtz resonator 


BEND 

X 

Y 

A 

B(3) 


Commons PIPPXY 

Variables 

in Argument List 

DIA 

REAL*4 

diameter of opening (ft) 

ITYPE(200) 

INTEGER* 2 

type plot element 

J 

INTEGER* 2 

pointer to element 

LEN 

REAL*4 

length of opening (ft) 

POINTS, 200) 

REAL*4 

description of plot element 

VOL 

REAL*4 

volume of reservoir (ft“3) 


Local Variables 

OOSOLD 

REAL* 4 

intermediate variable 

DIAM 

REAL*4 

intermediate variable 

SIDE 

REAL*4 

intermediate variable 

SINOID 

REAL*4 

intermediate variable 

XC 

REAL*4 

intermediate variable 

XHOLD 

REAL* 4 

intermediate variable 

XLOLD 

REAL* 4 

intermediate variable 

XOLD 

REAL*4 

intermediate variable 

YC 

REAL*4 

intermediate variable 

YHOLD 

REAL* 4 

intermediate variable 

YLOLD 

REAL* 4 

intermediate variable 

YOLD 

REAL* 4 

intermediate variable 


SUBROUTINE IOX 

Handles fuel piping logic 
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Commons EPARAM 

GOX(25) 

IGONE 

IUNIT 

IUNITP 

S 

ANS 

IDXIN 


FOPIPE OPARAM WCAOUT 
Variables in Argument List 
C0MPLEX*8 admittance looking toward tank 
INTEGER*2 flag for subroutine fuel or lox 
INTEGER* 2 unit number of lox data file 
INTEGER*2 unit number of lox work file 
CCMPLEX*8 current frequency 
Local Variables 

CHAR*1 response to question 

CHAR*24 name of lox data file 


SUBROUTINE MODCON 

Modifies CONST. RLN parameters 


CSTAR(25) 

REAL*4 

DCDR(25) 

REAL*4 

IUNIT 

INTEGER* 2 

MENG 

INTEGER* 2 

RBAR(25) 

REAL*4 

TAUT (25) 

REAL*4 

THEIAC(25) 

REAL*4 

VARI 

CHAR*24 
Local Varii 

ANS 

CHAR*1 

I 

INTEGER* 2 

II 

INTEGER* 2 

J 

INTEGER* 2 

NAME 

CHAR* 8 

VALUE 

REAL*4 

VARL(5) 

CHAR* 8 

VAKU(5) 

CHAR* 8 

SUBROUTINE MODENG 


Variables in Argument List 

characteristic rocket velocity (ft/sec) 
change in velocity with mixture ratio (ft/sec) 
unit number for CONST data 
number of engines 
mixture ratio 
transport lag (sec) 
characteristic time constant (sec) 
name of CONST data file 
oles 

response to question 
pointer 
do loop index 
do loop index 

name of variable to be modified 
value of variable to be modified 
array of names (lower case) 
array of names (upper case) 


Modifies engine parameters 


Commons EPARAM 

IUNIT 

NAMENG 

ANS 

I 

II 
J 

NAME 

VALUE 

VARL(3) 

VARU(3) 


Variables in Argument List 
INTEGER* 2 unit number of engine data file 
CHAR*24 name of engine data file 
Local Variables 

CHAR*1 response to question 
INTEGER* 2 pointer 
INTEGER* 2 do loop index 
INTEGER* 2 do loop index 

CHAR*8 name of variable to be modified 
REAL*4 value of variable to be modified 
char* 8 array of names (lower case) 

CHAR* 8 array of names (upper case) 
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SUBROUTINE MODIFY 

Allows modifications to input data 


Commons EPARAM 
A(25) 

AREA(75, 25) 
AVGK(25) 
CMAN(25) 
CIANK(25) 

DENS (25) 
DIA(75,25) 
IENG(25) 
ITANK(25) 

IUNIT 

KMAN(25) 

KEANK(25) 

L(75,25) 

LFD0W(25) 

LOPEND(25) 

IOPOLD(25) 

MLINE 

NOLINE(25) 

PCAP(75, 25) 

PIND(75,25) 

PIPE1(75,25) 

PIPE2 (75,25) 

PIPE3 (75,25) 

PIPE4 (75,25) 

PIPE5(75,25) 

SECIN(75,25) 

SEGMN (25) 

SPLIT(25) 

TITL 

VOL(25) 

VOLMF(25) 

ANS 

I 

II 

III 
IP 
IPP 

ISEXMN 

IT 

J 

K 

M 

NAMNAM 

SECT 


TANK WCAOUT 
Variables in Argument List 
REAL* 4 speed of sound in the fluid (ft/ sec) 

REAL*4 area of pipe section (ft‘2) 

REAL*4 average bulk modulus 
REAL*4 manifold capacitance 
REAL*4 tank capacitance 
REAL*4 density of fluid (lbm/ft'3) 

REAL* 4 diameter of pipe section (ft) 

INTEGER*2 engine number 
INTEGER*2 tank number 

INTEGER*2 unit number of fuel or lox file 
REAL*4 bulk modulus of manifold (lbf/ft“2) 

REAL*4 bulk modulus of tank (lbf/ft~2) 

REAL*4 length of pipe section (ft) 

REAL*4 flow rate through pipe (lhm/sec) 

INTEGER* 2 maximum number of iterations for split pipe 

INTEGER*2 previous maximum number of iterations 

INTEGER*2 number of lines from tank 

INTEGER* 2 number of identical lines 

REAL*4 capacitance of pipe section 

REAL*4 inductance of pipe section 

REAL* 4 first parameter of pipe description 

REAL*4 second parameter of pipe description 

REAL*4 third parameter of pipe description 

REAL*4 fourth parameter of pipe description 

REAL*4 fifth parameter of pipe description 

INTEGER* 2 pipe section type 

INTEGER* 2 number of pipe sections 

REAL*4 number of unique lines from pipe split 

CHAR*20 title from input file 

REAL*4 volume of tank (ft“3) 

REAL*4 volume of manifold (ft~3) 

Local Variables 

CHAR*1 response to question 

INTEGER* 2 pointer 

INTEGER*2 do loop index 

INTEGER* 2 do loop index 

INTEGER* 2 pointer to current segment 

INTEGER*2 do loop index 

INTEGER*2 intermediate variable 

INTEGER* 2 current tank number 

INTEGER* 2 do loop index 

INTEGER* 2 do loop index 

INTEGER* 2 do loop index 

INTEGER* 2 pointer, fuel or lox 

REAL* 4 type of segment 
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SUBROUTINE MODTAN 

Modifies tank parameters 


A(25) 

CIANK(25) 

DENS (25) 

KIANK(25) 

LFICW(25) 

MEANK 

VOL(25) 

ANS 

GRAV 

I 

II 
J 

NAME 

VALUE 

VARL(4) 

VARU(4) 


Variables 
REAL* 4 
REAL* 4 
REAL*4 
REAL* 4 
REAL* 4 
INTEGER*2 
REAL*4 


in Argument List 

speed of sound in the fluid (ft/sec) 

tank capacitance 

density of fluid (ltm/ft‘3) 

bulk modulus of tank (lbf/ft“2) 

flow rate through pipe (Urn/ sec) 

number of tanks 

volume of tank (ft~3) 


Local Variables 

CHAR*1 response to question 

rEal* 4 gravitational constant ( lhm-f t/ lbf — sec 2) 

INTEGER* 2 pointer 

INTEGER*2 do loop index 

INTEGER* 2 do loop index . . 

CHAR*8 name of variable to be modified 
rEAL*4 value of variable to be modified 
CHAR*8 array of names (lower case) 
char* 8 array of names (upper case) 


SUBROUTINE NYQUIS 

Computes the K() ’s 


Commons EPARAM 

CSTAR(25) 

DCDR(25) 

GF(25) 

GOX(25) 

IFUEL 

HOX 

RBAR(25) 

S 

TAUT (25) 
THEIAC(25) 

I 

J 

K 

KG1(25) 

KG2 

KG3 

K1C(25) 

K2C(25) 

K3C(25) 

K4C(25) 

K1R(25) 

K2R(25) 

K3R(25) 

K4R(25) 


FACTOR SETUP 

Variables in Argument List 

REAL* 4 characteristic rocket velocity (ft/ sec) 

REAL*4 change in velocity with mixture ratio (ft/ sec) 

0CMPLEX*8 admittance of fuel line looking tcward tank 

COMPLEX*8 admittance of lox line looking tcward tank 

INTEGER*2 flag indicating presence of fuel line 

INTEGER* 2 flag indicating presence of lox line 

REAL*4 mixture ratio 

C0MPLEX*8 complex frequency 

REAL*4 transport lag (sec) 

real* 4 characteristic time constant (sec) 

Local Variables 
INTEGER* 2 do loop index 
INTEGER* 2 do loop index 
INTEGER*2 current engine number 
O0MFLEX*8 K(jw) 

COMPLEX* 8 K(jw,GOX) 

0CMPLEX*8 K(jw,GF) 

rEAL* 4 complex part of K(jw) 

REAL* 4 complex part of K(jw,GOX) 

REAL*4 corrplex part of K(jw,GF) 

REAL*4 complex part of K(jw,GOX,GF) 

REAL*4 real part of K(jw) 

REAL* 4 real part of K(jw,GOX) 

REAL*4 real part of K(jw,GF) 

REAL*4 real part of K(jw,GOX,GF) 
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L 


INTEGER*2 pointer 


SUBROUTINE RLINE 

Reads fuel or lox file. 


Commons EPARAM 
A(25) 

AREA(75,25) 

AVGK(25) 

CMAN (25) 
CIANK(25) 

DENS (25) 
DIA(75,25) 
IENG(25) 
ITANK(25) 

IUNIT 

KMAN(25) 

RIANK(25) 

L(75,25) 

LFLOW(25) 

I£)PEND(25) 

LOPOLD(25) 

MLINE 

NOLINE (25) 

PCAP(75,25) 

PIND(75, 25) 

PIPE1(75,25) 

PIPE2 (75,25) 

PIPE3 (75,25) 

PIPE4 (75,25) 

PIPES (75, 25) 

SEXHN(75,25) 

SEGMN (25) 

SPLTT(25) 

TITL 

VOL(25) 

VOLMF(25) 

ANS 

DIVAVG 

I 

IE 

IT 

J 

M 

MM 


TANK 

Variables in Argument List 
PEAL* 4 speed of sound in the fluid (ft/sec) 

REAL*4 area of pipe section (ft'2) 

REAL*4 average tube modulus 
REAL* 4 manifold capacitance 
REAL*4 tank capacitance 
REAL*4 density of fluid (ltm/ft*3) 

REAL*4 diameter of pipe section (ft) 

INTEGER* 2 engine number 
INTEGER* 2 tank number 

INTEGER* 2 unit number of fuel or lox file 
REAL*4 bulk modulus of manifold (lbf/ft*2) 

REAL* 4 bulk modulus of tank (lbf/ft'2) 

EEAL*4 length of pipe section (ft) 

REAL*4 flow rate thrcu^i pipe (bxn/sec) 

INTEGER* 2 maximum number of iterations for split pipe 

INTEGER* 2 previous maximum number of iterations 

INTEGER*2 number of lines from tank 

INTEGER*2 number of identical lines 

REAL* 4 capacitance of pipe section 

REAL*4 inductance of pipe section 

REAL*4 first parameter of pipe description 

REAL*4 second parameter of pipe description 

REAL*4 third parameter of pipe description 

rEAL* 4 fourth parameter of pipe description 

REAL*4 fifth parameter of pipe description 

INTEGER* 2 pipe section type 

INTEGER* 2 number of pipe sections 

REAL*4 number of unique lines from pipe split 

CHAR*20 title from input file 

REAL*4 volume of tank (ft‘3) 

REAL*4 volume of manifold (ft" 3) 

Local Variables 

CHAR*1 response to question 
REAL* 4 intermediate variable 
INTEGER* 2 do loop index 
INTEGER*2 current engine number 
INTEGER* 2 current tank number 
INTEGER* 2 do loop index 
INTEGER* 2 pointer 
INTEGER* 2 do loop index 


SUBROUTINE RTYPE 

Stores values for different types of piping 
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AREA 

REAL*4 

AVGK 

REALM 

CMAN 

REAL* 4 

DENS 

REAL* 4 

DIA 

REALM 

KMAN 

REALM 

L 

REALM 

PGAP 

REALM 

PIND 

REALM 

PIPE1 

REALM 

PIPE2 

REALM 

PIPED 

REALM 

PXPE4 

REAL* 4 

PIPES 

REALM 

SECIN 

INTEGER* 2 

VOIMF 

REALM 
Local Varic 

AREAB 

REALM 

DIME 

REALM 

GRAV 

REALM 

PI 

REALM 

VALUE 

REALM 

SUBROUTINE STSECT 

Computes plot coordinal 
Commons PIPPXY 

Variables ; 

DIA 

REALM 

ITYPE(200) 

INTEGER*2 

J 

INTEGER* 2 

LEN 

REALM 

POINT(8 / 200) 

REALM 


Variables in Argument List 

area of pipe section (ft *2) 
average bulk modulus 
manifold capacitance 
density of fluid (ltm/ft~3) 
diameter of pipe section (ft) 
bulk modulus of manifold (lbf/ft~2) 
length of pipe section (ft) 
capacitance of pipe section 
inductance of pipe section 
first parameter of pipe description 
second parameter of pipe description 
third parameter of pipe description 
fourth parameter of pipe description 
fifth parameter of pipe description 
pipe section type 
volume of manifold (ft~3) 
bles 

area of pipe 
diameter of pipe 

gravitational constant (ltm-ft/lbf-sec*2) 
mathematical constant 
length of pipe 


diameter of segment (ft) 
type plot element 
pointer to element 
length of segment (ft) 
description of plot element 


SUBROUTINE TANKNO 

Reads tank parameters 

Variables in Argument List 


A(25) 

REAL*4 

speed of sound in the fluid (ft/ sec) 

CIANK(25) 

REALM 

tank capacitance 

DENS (25) 

REALM 

density of fluid (lhm/ft“3) 

IUNIT 

INTEGER* 2 

unit number of fuel or lox file 

KIANK(25) 

REALM 

bulk modulus of tank (lbf/ft“2) 

LFLOW(25) 

REALM 

flow rate through pipe (11m/ sec) 

MEANK 

INTEGER* 2 

number of tanks 

VOL(25) 

REALM 

volume of tank (ft* 3) 


Local Variables 

GRAV 

REALM 

gravitational constant (lhm-ft/lbf— sec~2) 

I 

INTEGER* 2 

do loop index 
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SUBROUTINE TSSECT 

Compu tes plot coordinates for a tuned stub 
Commons PIPPXY 

Variables in Argument List 
REAL*4 diameter of tuned stub (ft) 
INTEGER* 2 type plot element 
INTEGER* 2 pointer to element 
REAL* 4 length of tuned stub 
REAL*4 description of plot element 
Local Variables 

REAL*4 intermediate variable 


DIA 

mPE(200) 

J 

LEN 

POINT(8,200) 

DIAM 


SUBROUTINE ZREAD 

Reads input for input modification 


Variables in Argument List 


NAME(8) 

CHAR*1 

name of input variable 

VALUE 

REAL* 4 value of input variable 

Local Variables 

BIK 

CHAR*1 

i i 

CARD(80) 

CHAR*1 

card image 

CEND(3) 

CHAR*1 

•EVNVD' 

OCMMA 

CHAR*1 

1 f 
/ 

CITT(5) 

CHAR*1 

'T' , 'I' , 'T* , 'L' , 'E' 

DCARD 

CHAR*80 

card image 

E 

CHAR*1 

'E' 

FRACT 

REAL*4 

fractional part of number 

I 

INTEGER* 2 

do loop index 

IOOUNT 

INTEGER* 2 

position counter 

ID 

INTEGER* 2 

position counter 

II 

INTEGER*2 

position counter 

J 

INTEGER* 2 

do loop index 

JJ 

INTEGER* 2 

position counter 
'e' 

LE 

CHAR*1 

LEND(3) 

CHAR*1 

•e\'n\ 'd' 

LTTT(5) 

CHAR*1 

•t', 'i\ 't', 'l' # 'e' 

MINUS 

CHAR*1 

1 — 1 

NUMBER(IO) 

CHAR*1 

•O', '1', ’2', '3', '4', '5', '6 

PERIOD 

CHAR*1 

i i 

PLUS 

CHAR*1 

' + • 

POUND 

CHAR*1 


QUEST 

CHAR*1 


SIGN 

REAL*4 

sign of number or exponent 

WHOLE 

REAL*4 

whole part of number 
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7.0 Program Listing 


C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PROGRAM NYQUIST 03-24-92 

Program to calculate values for a Nyquist plot using no fusl or 
lox lines, fuel line only, lox line only, or fuel and lox lines 

Hiis program will handle the following type elements 

Straight pipes 
Bends 

Inline accumulators 
Tuned stub accumulators 
Helmholtz resonators 
Parallel resonators 
Pumps 

Split pipes 
Multiple tanks 
Multiple engines 


C 

$IARGE 

INCLUDE 'FGRAPH.FI' 

INCLUDE 'PGRAPH.FD' 

COMMON /NOOOL/NOOLS , NMODE 
INTEGER* 2 NCOLS, NMODE 

INTEGER* 2 IHR, IMIN , ISEC, 1100 , IYR, IMDN, IDAY 
CHARACTER*2 AM,FM,AP 

COMMON /EPARAM/MENG,TFIOW(25) ,PCHMB(25) ,DERDR(25) 

INTEGER SEGMNF(25) ,SECINF(75,25) ,NOLINF(25) ,IENGF(25) ,ITANKF(2 ), 

* LOPOLF(25) ,LOPENF(25) 

REAL KMANF(25) ,KTANKF(25) ,LFDCWF(25) ,LF(75,25) 

COMMON /FPARAM/MLINEF , SPLITF (25) ,AF(25) ,CMANF(25) ,CTMDT(25) , 

* 7 DENSF(25) ,KMANF,KEANKF,LFLCWF,VOLF(25) ,VOLMFF(25) , 

* AREAF(75,25) ,DIAF(75,25) ,LF,PINDF(75,25) , 

* PCAPF(75,25) ,AVGKF(25) , 

* SEGMNF , SECINF , NOLINF , IENGF , ITANKF , LDPOLF , LOPENF 
INTEGER SEGMNO(25) ,SECINO(75,25) ,NOLINO(25) ,IENGO(25) ,TEANKO(25) , 

* LOPOLO(25) ,LOPENO(25) 

REAL KMANO(25) ,KTANKO(25) ,LFIDW0(25) ,10(75,25) 

COMMON /OPARAM/MLINEO , SPLITO ( 25) ,AO(25) ,CMANO(25) ,CTANKO(25) , 

* DENSO(25) ,KMANO,KTANKO,LFLCWO,VOLO(25) ,VOLMFO(25) , 

* AREAO(75, 25) ,DIAO(75,25) ,ID,PIND0(75, 25) , 

* PCAPO(75,25),AVGKO(25), 

* SEGMNO , SECINO , NOLINO , IENGO , ITANKO , LOPOIO , LOPENO 

COMPLEX S,GF(25) ,GOX(25) 

REAL K1R(1001) ,K2R(1001) ,K3R(1001) ,K1C(1001) ,K2C(1001) ,K3C(1001) 

REAL K4R(1001) ,K4C(1001) ,KW(1001) 

COMMON /W0RK1/K1R,K1C,K2R,K2C,K3R,K3C,K4R,K4C,DUMMY1 (3392) 

REAL LFREQ,TAUT(25) ,CSTAR(25) ,RBAR(25) ,'IHErAC(25) ,DCDR(25) 
INTEGER PTS 
CHARACTER*! ANS 
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CHARACTER* 2 ANSI 
EQUIVALENCE (ANS,ANS1(1: 1) ) 

CHARACTER*24 NAMLIN ( 2 ), NAMENG 
CHARACTER*40 TITLE 
CHARACTER*20 TTTLF 
CHARACTER* 2 4 VARI 

COMMON /VTCATIT/TITLE,TITLF,IHR,IMIN,AP,IYR,IMON,IDAY 
CXMMON / WCAOUT / NAMLIN 
COMMON /FACTOR/ SFAC 
INTEGER SEGMN, SECIN(150) 

COMMON /SETUP/PIPE1 ( 150) ,PIPE2 (150) ,PIPE3 (150) ,PIPE4 (150) , 

* NENGF(25) ,NTANKF(25) ,NLINEF(25) ,NSPF(25) ,ILINEF, 

* NENGO(25) ,NTANKO(25) ,NIJNED(25) ,NSPO(25) ,ILINEO, 

* SEGMN, SECTN 
DATA AM/'AM7,FM/'FM'/ 

1 FORMAT (A20, IX ,12. 2, ' : ' ,I2.2,A2,4X,I2.2, ,12.2, ,12.2) 

OPEN ( 17, FORM=' UNFORMATTED') 

OPEN (UNir=14,ETLE='NYQ. OUT') 

CALL GEITTM(IHR / IMIN, ISEC, 1100) 

CALL GEIDAT (IYR, IMON, IDAY) 

IYR=IYR-1900 
CALL CLEARSCREEN(O) 

WRITE(*, ' (10X,A) ') 

*'n — — ■ 

WRITE(*, ' (10X,A) ') 

*'« II' 

IF(IHR.LT. 12) THEN 
WRITER, ' (10X,A) ') 

* ' || Good Morning and Welcome to NYQUISTi 1 || ' 

AP=AM 
FT.qR 

WRITE(*, ' (10X,A) ') 

*'|| Good Afternoon and Welcome to NYQUIST! i || ' 

AP=EM 

IF(IHR.GT. 12) IHR=IHR-12 
ENDIF 

WRITE(*,'(10X,A) ') 

*•11 11 

WRITE(*, ' (10X,A) ') 

* • || Program NYQUIST provides stability predictions || 

WRITE (*, ' (10X,A) ') 

* • || of feedline systems || ' 

WRITE(*,'(10X,A) ') 

*•11 * 

WRITE(*,'(10X,A) ') . Bi 

* • || To send a plot to the printer || 

WRITE(*, ' (10X,A) *) 

*1 I ' 

WRITE(*, ' (10X,A) ') , Bl 

* ' || The computer MUST be in GRAPHICS mode || 1 

WRITE(*, ' (10X,A) ') 

*•11 I ' 

WRTrE(*, ' (10X,A) ') 
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* ' || Hit PrScn to send the current plot to the printer 

WRITE(*, ' (10X, A) ') 

*1 

WRITE(*, ' (10X,A) ') 

. • II 


WRITE(*,*) 1 ' 

SFAC=1 • 0 

WRITEf*, ' (A) ') 1 If you want frequency in rad/sec, hit enter. ' 
WRTTE(*, ' (A\) ') ' If you want it in Hertz, enter "H". 

KEAD(*, ' (A) ' ) ANS 

IF(ANS.BQ. 'H 1 .OR.ANS.BQ. 'h') SFAG=6. 283185 

21 CONTINUE . _ , 

WRITE(*, 1 (A\) 1 ) ' Do you have FUEL data? 

READ(*, ' (A) ' ) ANS 

IF (ANS .EQ.'N' .OR. ANS .EQ. 'n') THEN 
IFUELf=l 
ELSE 
IFUEL=0 

ENDIF J ^ _ , 

WRITE(*, ' (A\) ') ' Do you have LOX data? 

READ(*, ' (A) ' ) ANS 

IF (ANS .EQ.'N' .OR. ANS .EQ. 'n') THEN 
ILOX=l 
ELSE 

nox=o 

ENDIF 

IF(IFUEL.EQ.O.OR.HOX.EQ.O) THEN . /w/ ... , 

W rtte(* / ' (A\) ') ' Is the engine data on file ENG.RIN? (Y/N) 
READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'N' .AND.ANS.NE. 'n') THEN 
NAMENG=' ENG.RIN' 

ELSE . . . , . , 

WRrrE(*, ' (A\) ') ' Enter name of file with the engine data 

READ(*, ' (A) ' )NAMENG 

ENDIF 

OPEN (UNIT=9 , FILE)=NAMENG) 

JUNIT=9 

CALL ENGNO(JUNIT) 

ELSE 

MENG=1 

ENDIF 

IF(IFUEL.E)Q.O) THEN 
IGONE=2 

CALL FUEL(S,GF, 11, 16, IGONE) 

ENDIF 

IF(HOX.EQ.O) THEN 
IGONE=2 

CALL LOX(S,GOX, 10, 15, IGONE) 

ENDIF 

IGQNEX) _ . /v / xt\ • 

» Are the following variables in a file. (Y/N) 

WRITE(*,*) ' ’ 

WRITE(*,*) ' VARIABLES ' 
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WRITE(*,*) 1 TRANSPORT LAG' 

WRITE(*,*) ' CHARACTERISTIC ROCKET VELOCITY' 

WRITe!*,*) ' MIXTURE RATIO ' 

WRrTE(*, *) ' CHARACTERISTIC TIME CONSTANT ' 

WRITE(*,*) ' CHANGE IN VELOCITY WITH MIXTURE RATIO ' 

WRITER,*) ' ' 

READ(*, ' (A) 1 ) ANS 

IF (ANS .EQ. 'N' .OR. ANS .EQ. 'n') THEN 
WRITE (*,*) ' File BUFFY.DOG will be created ' 

OPEN (UNIT=12 , FILE= ' BUFFY . DOG ' ) 

VARI=' BUFFY.DOG' 

WRITE(*, *) 'Enter values for VARIABLES as listed above. 1 
DO 24 I=1,MENG 

22 CONTINUE 

WRITE(*,'(" for engine #" ,12) * ) I 

READ(*,*,ERR=23)TAUT(I) ,CSTAR(I) ,RBAR(I) ,THEIAC(I) ,DCDR(I) 

WRITE (12 , ' (1P5E15.5) ')TAUT(I) ,CSTAR(I) ,RBAR(I) ,THEIAC(I) ,DCDR(I) 
GO TO 24 

23 CONTINUE 

WRITE (*, *) ' Enter numeric values only. Please try again !i' 

GO TO 22 

24 CONTINUE 
ELSE 

WRTTE(*, ' (A\) ') ' Is the name of the file CONST. RIN? (Y/N) 

READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. 'N' .OR.ANS.EQ. 'n') THEN 

WRITE(*, ' (A\) ') ' Enter name of file with VARIABLES data ' 
READ(*, ' (A) ' ) VARI 
ELSE 

VARI=' CONST. RLN' 

ENDIF 

OPEN (UNIT=12 , FILE=VARI ) 

DO 25 I=1,MENG 

READ (12, *) TAUT (I) ,CSIAR(I) ,RBAR(I) ,THEIAC(I) ,DCDR(I) 

25 CONTINUE 
ENDIF 

26 CONTINUE 

WRITE(*,*) ' Enter 20 character title' 

READ(*, ' (A) ' )TTTLF 

WRITE (TITLE, l)TTTLF,IHR,IMIN,AP,IMON,IDAY,rYR 

27 CONTINUE 
REWIND 17 

28 CONTINUE 
IF(SFAC.EQ.l.O) THEN 

WRITE (*,*) ' Enter range of frequencies in rad/ sec ' 

ELSE 

WRITE (*,*) ' Enter range of frequencies in Hertz ' 

ENDIF 

WRITE(*,*) ' Low freq, high freq, #pts' 

WRITE(*,*) ' 1001 = Maximum number of points' 

READ(*, *,ERR=29)LFREQ,HFREQ,PTS 
IF(LFREQ.LE.O.O) LFREQ=1.0E-5 
IF(PTS.LE.l) GO TO 49 
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GO TO 30 

29 CONTINUE 

WRITE(*,*) ' Enter numeric values only. Please try again !! ' 

GO TO 28 

30 CONTINUE 
NPTS=PTS/3 
IF(NPTS.GT.l) THEN 

SSIZE1=0 . 1* (HFREQ-LFREQ) / (NPTS-1) 

SSIZE2=0. 3* (HFREQ-LFREQ) /NPTS 
IF(3*NPTS.EQ.PTS) THEN 
SSIZE3=0. 6* (HFREQ-LFREQ) /NPTS 
ELSEIF(3*NPTS.EQ.PTS-1) THEN 
SSIZE3=0 . 6* (HFREQ-LFREQ) / (NPTS+1) 

ELSEIF ( 3 *NPTS . EQ . PTS-2 ) THEN 
SSIZE3=0. 6* (HFREQ-LFREQ) / (NFTS+2) 

ENDIF 

ELSE 

SSIZE1= (HFREQ-LFREQ) / (PTS-1) 

NPTS=PTS 

ENDIF 

IF(IFUEL.EQ.O.OR.ILOX.E)Q.O) THEN 
IF(IFUEL.NE.O) THEN 
CALL LPLOT(HOX) 

ELSEIF(ILOX.NE.O) THEN 
CALL FPLOT(ILOX) 

ELSE 

CALL FLPIOT(HOX) 

ENDIF 

ENDIF 

WRITE (*,*) ' Please wait while computations proceed. ' 

W=LFREQ 

WRITE (14, ' (IX, A/) ') TITLE 
I F ( IFUEL . NE . 0 . AND . HOX . NE . 0 ) 

* WRITE (14 , ' (/4X, ' 'FREQ. ' ' ,7X, ' 'Kl(R) ' ' ,7X, • 'Kl(I) ") ') 
IF(IFUEL.EQ.O.AND.ILOX.NE.O) WRTrE(14, ' (/4X, • 'FREQ. 1 ' ,7X, 

* ' 'Kl(R) ' ' ,7X, ' 'Kl(I) ' 1 5X, » 'ENG. ",4X, ' 'K3(R) ' ' ,7X, ' 'K3(I) "/) ') 

IF ( IFUEL. NE. 0. AND. ILOX.EQ. 0) WRITE(14, ' (/4X, ' 'FREQ. ' ' ,7X, 

* » 'Kl(R) ' ' ,7X, ' 'Kl(I) "5X, ' 'ENG. ' ' ,4X, 1 *K2(R) ' ' ,7X, "K2(I) "/) ') 

IF (IFUEL. E)Q.O. AND. HDX.BQ.O) THEN 

WRITE (14, ' (/4X, ' 'FREQ. ",7X, ' 'Kl(R) ' ',7X, ' 'Kl(I) ") ') 

WRITE (14, ' (5X, ' 'ENG. " ,2X, ' 'K2(R) ' ' ,7X, ' 'K2(I) ' * ,7X, ' 'K3 (R) ' ' ,7X, 

* ' 'K3 (I) ’ ',7X, ' ' K4 (R) ",7X, ' *K4(I) "/) ') 

ENDIF 

DO 31 K=1 , PIS 
IF(K.LE.NPTS) THEN 
IF(K.GT.l) W=W+SSIZE1 
ELSEIF (K.GT. 2 *NPTS) THEN 
W=W+SSIZE3 
ELSE 

W=W+SSIZE2 

ENDIF 

IF (K.E3Q.PTS) THEN 
W=HFREQ 
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ENDIF 

KW(K)=W 

S=CMPLX (0.0, SFAC*W) 

IF (IFUEL. BQ. 0) CALL FUEL(S,GF, 11, 16, IGONE) 

IF(ILOX.BQ.O) CALL I£>X(S,GOX,10,15,IGONE) 

CALL NYQUIS (GF, GOX, S , TAUT, CSTAR, FEAR, DCDR, THETAC, IFUEL, UOX) 

31 CONTINUE 

32 CONTINUE 

WRITE(*,*) ' Enter graph selection ' 

WRITE(*,*)' ' # , 

WRITE (*,*) ' 1 Nyquist plot independent of fuel or lox. 

IF(HJOX.BQ.O) 

* WRITE(*,*) 1 2 Nyquist plot independent of fuel. ' 

IF (IFUEL. EQ.O) 

* WRITE(*,*) 1 3 Nyquist plot independent of lox. ' 

IF ( HJDX . EQ . 0 . AND . IFUEL . EQ . 0 ) 

* WRITE (*,*) ' 4 Nyquist plot with fuel and lox. ' 

WRITE (*,*) ' 5 Phase-Gain plot independent of fuel or lox. ' 

IF(HOX.BQ.O) 

* WRITE(*,*) ' 6 Phase-Gain plot independent of fuel. ' 

IF (IFUEL. EQ.O) 

* WRITE (*,*) 1 7 Phase-Gain plot independent of lox. 

IF ( ruox . EQ . 0 . AND . IFUEL. BQ . 0 ) 

* WRITE (*,*) ' 8 Phase-Gain plot with fuel and lox. 1 

WRITE(*,*) 1 9 End plots. 1 

WRITE(*,*)' ' 

ANS1(2:2)=' ' 

READ(*, ' (A) ' ) ANSI 
IF(ANS.EQ. '9') GO TO 49 
IF(ANS1(2:2) .NE. 1 ' .OR.ANS.EQ. 'O' ) THEN 
WRITE (*, *) ' Number must be between 1 and 9, TRY AGAIN' 

GO TO 32 
ENDIF 

IF(HOX.EQ.l) THEN 

IF(ANS.EQ. '2' .OR.ANS.EQ. '4' .OR.ANS.EQ. '6' .OR.ANS.EQ. '8') THEN 
WRITE(*, *) ' No LOX file, do not use 2, 4, 6, 8' 

GO TO 32 
ENDIF 
ENDIF 

IF (IFUEL. EQ.l) THEN 

IF (ANS.EJQ. '3 '.OR.ANS.EQ. '4 ' .OR.ANS.GE. *7') THEN 
WRITE(*, *) ' No FUEL file, do not use 3, 4, 7, 8' 

GO TO 32 
ENDIF 
ENDIF 

CALL GEITTM(IHR, MEN, ISEC, 1100) 

CALL GETDAT (IYR, IMON, IDAY) 

IYR=IYR-1900 
IF(IHR.LT. 12) THEN 
AP=AM 
ELSE 
AP=PM 

IF(IHR.GT. 12) IHRfIHR-12 


61 


ENDIF 

IF(ANS.BQ. '1') THEN 
K=1 

CALL GETKS (PTS,K, 0, 0,K1R,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 
CALL ALLPT(K1R,K1C,FTS, 1,NTANKF(1) ,NTANKO(l) ,K) 
ELSEIF(ANS.BQ. '2') THEN 
IF(ILINEO.EQ.l) THEN 
J=1 
ELSE 

WRITE (*,*) ' The following LOX lines are available' 
WRITE(*, ' (/" Line # Tank# Engine#"/)') 

DO 33 J=1 , TT iINBO 

WRITE(*, ' (15,110,111) ' ) J , NTANKO ( J) ,NENGO(J) 

33 CONTINUE 

34 CONTINUE 

WRITE (*, ' (/' ' Enter line # to be plotted "\) ') 
READ(*,*)J 

IF (J.LE.O.OR. J.GT. ILINEO) THEN 
WRITE(*, *) ' Line # invalid, try again' 

GO TO 34 
ENDIF 
ENDIF 
K=NENGO(J) 

CALL GEIKS(PTS,K,0,J,K1R,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 
CALL ALLPT(K2R,K2C,PTS,2,NTANKF(1) , NTANKO (J) ,K) 
ELSEIF(ANS.EQ. '3') THEN 
IF(ILINEF.EQ.l) THEN 
1=1 

ELSE , . 

WRITE (*, *) ' The following FUEL lines are available 
WRITE(*, ' (/" Line # Tank # Engine #"/)') 

DO 35 1=1 , TT INEF 

WRITE(*, ' (15,110,111) ') I, NTANKF(I) ,NENGF(I) 

35 CONTINUE 

36 CONTINUE 

WRITE(*, ' (/' ' Enter line # to be plotted "\) ') 
READ(*,*)I 

IF(I.LE.O.OR.I.GT.ILINEF) THEN 
WRITE(*,*) ' Line # invalid, try again' 

GO TO 36 
ENDIF 
ENDIF 
K=NENGF(I) 

CALL GEIKS(PrS,K,I,0,KlR,K2R,K3R / K4R,KlC,K2C,K3C,K4C) 
CALL ALLPT(K3R,K3C,FTS,3,NTANKF(I) ,NTANKO(l) ,K) 

ELSEIF(ANS.EQ. '4') THEN 
IF(ILINEF.EQ.l) THEN 
1=1 
ELSE 

WRITE (*,*) ' The following FUEL lines are available' 
WRITE (*,'(/" Line # Tank# Engine#"/)') 

DO 37 1=1, ILINEF 

WRITE(*, ' (15,110,111) ' ) I,NIANKF(I) ,NENGF(I) 
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37 

38 


39 


40 


CONTINUE 

CONTINUE 

WRITER, ' (/" Enter line # to be plotted \) ) 
READ(*,*)I 

IF(I.LE.O.OR.I.GT.ILINEF) THEN 
WRITE(*,*) ' Line # invalid, try again' 

GO TO 38 
ENDIF 
ENDIF 
K=NENGF(I) 

IF(HJNEO.E2.0) THEN 
J=1 


WRITE (*,*) 1 The following LOX lines are available' 
WRITE(*, ' (/ ' 1 Line # Tank # Engine #''/)') 
NOXY=0 

DO 39 J=l, ILINEO 
IF(NENGO(J) .NE.K) GO TO 39 
WRTrE(*, ' (15,110,111) ') J,NTANKO(J) ,NENGO(J) 
NOXY=NOXY+l 


NOXYP=J 

CONTINUE 

IF(NOXY.EQ.l) THEN 
J=NOXYP 
ELSE 

CONTINUE 

WRITE(*, ' (/" Enter line # to be plotted \) ) 
READ(*,*)J 

IF(J.LE.O.OR. J.GTT. ILINEO. OR. NENGO(J) .NE.K) THEN 
WRITE(*,*)' Line # invalid, try again' 


GO TO 40 
ENDIF 
ENDIF 
ENDIF 

CALL GETKS(PTS,K,I,J,K1R,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 
IF(K.NE.O) CALL ALLFT(K4R,K4C,PTS,4,NTANKF(I) ,NTANKO(J) , 
ELSEIF ( ANS . EQ . '5' ) THEN 


K) 


K=1 

CALL GETKS (PTS,K, 0, 0,K1R,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 
CALL PNYQ(K1R,K1C,KW,PTS, 1,NTANKF(1) ,^12^0(1),^ 
ELSEIF ( ANS. EQ. '6') THEN 
IF (ILINEO. EQ. 1) THEN 
J=1 


ELSE 

WRITE(*,*) ' The following LOX lines are available' 
WRITE ( * , 1 ( / ' ' Line # Tank # Engine # ' ' / ) ' ) 

DO 41 J=l, ILINEO 

WRITE(*, ' (15,110,111) , )J,NIANKO(J) / NENGO(J) 

41 CONTINUE 

42 CONTINUE 

WRITE(*, ' (/" Enter line # to be plotted "\) ') 
READ(*,*)J 

IF(J.LE. 0. OR. J.GT. ILINEO) THEN 
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WRITE(*,*) ' Line # invalid, try again' 

GO TO 42 
ENDIF 
ENDIF 
K=NENGO(J) 

CALL GETKS(PTS,K, 0, J,KLR,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 
CALL PNYQ(K2R,K2C,KW,PTS,2,NTANKF(1) ,NTANKO(J) ,K) 
ELSEIF(ANS.EQ. '7') THEN 
IF(ILINEF.EQ.l) THEN 
1=1 
ELSE 

WRITE (*,*) ' The following FUEL lines are available' 
WRITE(*, ' (/' ' Line # Tank # Engine #"/) ') 

DO 43 1=1, ILINEF 

WRrrE(*, ' (15,110,111) ' ) I,NTANKF(I) ,NINGF(I) 

43 CONTINUE 

44 CONTINUE 

WRITE(*, 1 (/" Enter line # to be plotted "\) 1 ) 
READ(*,*)I 

IF(I.LE.O.OR.I.GT.ILINEF) THEN 
WRITE(*,*) ' Line # invalid, try again' 

GO TO 44 
ENDIF 
ENDIF 
K=NENGF(I) 

CALL GETKS(PTS,K,1, 0,K1R,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 
rAT.T. PNYQ(K3R,K3C,KW,PTS,3,NTANKF(I) ,NTANKO(l) ,K) 
ELSEEF(ANS.EQ. '8') THEN 
IF ( ILINEF . EQ . 1 ) THEN 
1=1 
ELSE 

WRITE(*,*) ' The following FUEL lines are available' 
WRITE(*, ' (/' ' Line # Tank# Engine#"/)') 

DO 45 1=1, ILINEF 

WRITE(*, ' (15,110,111) ')I,NTANKF(I) ,NENGF(I) 

45 CONTINUE 

46 CONTINUE 

WRITE(*, ' (/ ' ' Enter line # to be plotted " \) ' ) 
READ(*,*)I 

IF(I.LE.O.OR.I.GT.ILINEF) THEN 
WRITE(*, *) ' Line # invalid, try again' 

GO TO 46 
ENDIF 
ENDIF 
K=NENGF(I) 

IF(ILINEO.EQ.l) THEN 
J=1 
ELSE 

WRITE (*,*) ' The following LOX lines are available' 
WRITE(*, • (/" Line # Tank # Engine #"/)') 
NOXY=0 

DO 47 J=l, ILINEO 
IF(NENGO(J) .NE.K) GO TO 47 
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WRITER, ' (15,110,111) ' ) J,NIANKO(J) ,NENGO(J) 

NOXY=NOXY+l 

NOXYP=CT 

47 CONTINUE 
IF(NOXY.BQ.l) THEN 

J=NOXYP 

ELSE 

48 CONTINUE 

WRITE(*, ' (/ " Enter line # to be plotted ’ 1 \) ' ) 

READ(*,*)J 

IF(J.LE.O.OR. J.GT.ILINEO.OR.NENGO(J) .NE.K) THEN 
WRITE(*,*) ' Line # invalid, try again' 

GO TO 48 
ENDIF 
ENDIF 
ENDIF 

CALL GETKS(PTS,K, I, J,K1R,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 
IF(K.NE.O) CALL PNYQ(K4R,K4C,KW,PTS,4,NTANKF(I) ,NTANKO(J) ,K) 
ENDIF 
GO TO 32 

49 CONTINUE 

WRITE (*,*) ' Enter E to exit, ' 

WRITE(*,*) ' F to run new frequency range, 1 

WRITE(*,*) ' C to run a new case, | 

WRITE(*, 1 (A\) ') ' N to read new files. 1 

READ(*, ' (A) ' JANS 

IF(ANS.EQ. 'F' .OR.ANS.BQ. 'f ') GO TO 27 
IF(ANS.E)Q. 'E' .OR.ANS.EQ. 'e') STOP 
IF(ANS.E)Q. 'C' .OR.ANS.EQ. 'c') THEN 
IF(ILOX.BQ.O.OR.IFUEL.BQ.O) THEN 

WRITE (*, ' (A\) ') ' Do you wish to modify engine file.? ' 
READ(*, ' (A) 1 ) ANS 

IF(ANS.E1Q. 'Y' .OR.ANS.BQ. *y * ) THEN 
CALL MODENG ( JUNIT , NAMENG) 

ELSE 

WRITE(*, ' (A\) ') ' Do you wish to rewind engine file.? ' 
READ(*, ' (A) ' ) ANS 

IF(ANS.BQ. 'Y' .OR.ANS.EQ. 'y') REWIND JUNIT 
CALL ENGNO (JUNIT) 

ENDIF 

ENDIF 

WRITE (*, ' (A\) ') ' Do you wish to modify CONST file.? 1 
READ(*, ' (A) 1 ) ANS 

IF(ANS.BQ. 'Y' .OR.ANS.EQ. 'y') THEN 
CALL MODOON( 12, VARI,MENG, TAUT, CSTAR, REAR, THETAC,DCDR) 

ELSE 

WRITE(*, ' (A\) ' ) ' Do you wish to rewind CONST file.? ' 
READ(*, ' (A) 1 ) ANS 

IF(ANS.BQ. 'Y' .OR.ANS.BQ. 'y') REWIND 12 
DO 50 1=1 , MENG 

READ (12,*) TAUT (I) ,CSTAR(I) ,RBAR(I) ,THEIAC(I) ,DODR(I) 

50 CONTINUE 
ENDIF 
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IF(IFUEL.EQ.O) THEN 
IGONE=l 

CALL FUEL(S,GF, 11, 16, IGONE) 

ENDIF 

IF(IIOX.EQ.O) THEN 
IGONE=l 

CALL LOX(S,GOX, 10, 15, IGONE) 

ENDIF 
IGONE=0 
GO TO 26 
ENDIF 

IF(ANS.EQ. 'N' .OR.ANS.EQ. 'n') THEN 
IF(IFUEL.E)Q.O) CLOSE(ll) 

IF(HOX.EQ.O) CLOSE (10) 

IF(IFUEL.EQ.O.OR.HOX.EQ.O) CLOSE (9) 

CLOSE (12) 

IFUEL=1 

nox=i 

REMIND 17 
GO TO 21 
ENDIF 

WRITE(*,*) ' You did not enter E, F, C, or N. Try again.' 

GO TO 49 
END 

SUBROUTINE ALLPr(VMOLD,GHOID,PTS,ITYPE,ITF / ITO,ING) 

C Supervises Nyquist plot 

INCLUDE 'FGRAPH.FD' 

RECORD/WXYOOORD/XY 
RECORD /RCOOORD/ S 
INTEGER*2 DUMWIL 
COMMON /NOCOL/NOOLS , NMODE 
REAL WHOLD(lOOl) ,GHOID(1001) 

REAL* 8 RMIN, RMAX, IMMIN, IMAX 
REAL*8 X, Y 
INTEGER PTS 
CHARACTER*38 ENGTNK 

1 FORMAT (15X, ' ’,17X) 

2 FORMAT (7X, 'Eng. #' ,I2,3X, 'IOX TANK #',I2,8X) 

3 P0RMAT(7X, 'Eng. #' ,12, 3X, 'FUEL TANK #' ,12, 7X) 

4 PORMAT('Eng. #',I2,3X, 'FUEL TANK #',I2,2X, 'IOX TANK #',I2) 
CALL SETPLT 

RMAX=WH0LD(1) 

RMIN=WH0LD(1) 

IMAX=GHOLD ( 1 ) 

IMMIN=GHOLD (1) 

DO 21 1=2, FTS 

IF (WHOLD (I) .GT. RMAX) RMAX=WHOLD (I) 

IF (WHOLD (I) .LT. RMIN) RMIN=WHOLD (I) 

IF(GHOID(I) .GT.IMAX) IMAX=GHOID(I) 

IF (GHOLD ( I) . LT. IMMIN) IMMIN=GHOLD (I) 

21 CONTINUE 

CALL IOWERW (RMIN, RMAX, IMAX, IMMIN) 

CALL NICEGRF(RMIN,RMAX,IMAX,IMMIN,ITYPE) 
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IF(ITYPE.E)Q.l) WRITE (ENGINE, 1) 
IF(ITYPE.EQ.2) WRITE (ENGINE, 2 ) ING,ITO 
IF(ITYPE. EQ. 3) WRITE (ENGINE, 3 )ING,ITF 
IF(ITYPE.EQ.4) WRITE (ENGINE, 4) ING,ITF,ITO 
IF(NM0DE.EQ.6) THEN 
CALL settextposition( 2, 1, s) 

CALL OUITEXT (ENGINE) 

ELSE 

CALL settextposition ( 2, 20, s) 

CALL OUITEXT ( ENGINE) 

ENDIF 

CALL SETLINESTYLE (62268) 

X=0.0 

Y=IMMIN 

CALL MOVETO_W(X,Y,XY) 

Y=IMAX 

DUMWTL=LINErO_W(X / Y) 

Y=0.0 

X=RMIN 

CALL MOVETOJW (X, Y, XY) 

X=FMAX 

DUMWIL=LINErO_W (X , Y) 

CALL SETLINESTYLE (6553 5) 

X=WHOID(l) 

Y=GK)LD(1) 

CALL MOVETOJW (X, Y, XY) 

DO 22 1=2, PTS 
X=WHOLD(I) 

Y=GHOII)(I) 

DUMWIL=LINET'0_W (X, Y) 

22 CONTINUE 
CALL ENDPLT 
RETURN 
END 

SUBROUTINE CURV(A1,A2) 

C Draws circular arc 

INCLUDE 'PGRAPH.FD' 

RECORD /WXYCOORD/XY 
INTEGER* 2 DUMWIL 

COMMON /ARCOON/XC,YC, RAD, ANG, ANGLE 

REAL*8 XP,YP,A1,A2 

ANG1=A1 

ANG2=A2 

DIH=ANG2-ANG1 

IF(DIH.LT.O.O) DIH=6 . 283185+DIH 

N=57.29578*DTH 

DA=DIH/ (N-l) 

XP=XC+RAD*SIN (ANG1 ) 

YP=YC-RAD*OOS (ANG1) 

CALL MOVEIOJW(XP,YP,XY) 

DO 21 1=1, N-l 
T=ANG1+I*DA 
XP=XC+RAD*SIN (T) 
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YP=YC-RAD*OOS (T) 

DUMWID=LINErO_W (XP , YP) 

21 CONTINUE 
RETURN 
END 

SUBROUTINE ENDPLT 
C Closes plot routines 

INCLUDE 'FGRAPH.FD' 

INTEGER* 2 dummy 

READ (*,*) I Wait for ENTER key to be pressed 

dummy = setvideomode ( $DEFAULTMODE ) 

RETURN 

END 

SUBROUTINE FLPLOT(HOX) 

C Supervises plot of piping 

COMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DPROR(25) ,FMRAT(25) 
INTEGER SEGMNF(25) ,SECINF(75,25) ,NOLINF(25) ,IENGF(25) ,ITANKF(25) , 

* LOPOLF(25) ,LOPENF(25) 

REAL KMANF(25) ,KIANKF(25) ,LFLCWF(25) ,LF(75,25) 

COMMON /FPARAM/MLINEF, SPLITF(25) ,AF(25) ,CMANF(25) ,CIANKF(25) , 

* DENSF(25) ,KMANF,KTANKF,LFI£WF,VOLF(25) ,VOLMFF(25) , 

* AREAF(75, 25) ,DIAF(75,25) ,LF,PINDF(75,25) , 

* PCAPF(75,25) ,AVGKF(25) , 

* SBGMNF, SECINF, NOLINF, IENGF, ITANKF , LOPOLF , IOPENF 
COMMON /F0PIPE/PIPE1F (75,25) ,PIPE2F(75,25) ,PIPE3F(75,25) , 

* PIPE4F(75,25) ,PIPE5F(75,25) 

INTEGER SEGMNO(25) ,SECTNO(75,25) ,NOLINO(25) ,IENGO(25) ,ITANKO(25) , 

* IOPOLO(25) ,IDPENO(25) 

REAL KMANO(25) ,KTANKO(25) ,LFI£W0(25) ,10(75,25) 

COMMON /OPARAM/MLINED,SPLITO(25) ,AO(25) ,CMANO(25) ,CIANKO(25) , 

* DENSO(25) ,KMANO,KEANKO,LFLC(WO,VOLO(25) ,VOLMPO(25) , 

* AREAO(75, 25) ,DIAO(75,25) ,ID,PIND0(75, 25) , 

* PCAPO(75,25) ,AVGK0(25) , 

* SEGMNO, SECINO, NOLINO, IENGO, ITANKO, IOPOLO, IOPENO 
INTEGER SEGMN, SECIN ( 150) 

COMMON /SETUP/PIPE1 ( 150) ,PIPE2(150) ,PIPE3(150) ,PIPE4(150) , 

* NENGF(25) ,NTANKF(25) ,NLINEF(25) ,NSPF(25) , ILINEF, 

* NENGO(25) ,NTANKO(25) ,NUNB0(25) ,NSPO(25) ,ILINEO, 

* SEGMN, SECIN 
TT.TN FF=D 

IPF=1 

DO 22 I=1,MLINEF 
IF(SPLITF(I) .EQ.O.O) THEN 
TT .TN FF= TT .TN EF+1 
NENGF ( ILINEF) =IENGF ( IPF) 

NTANKF ( ILINEF) =ITANKF ( I ) 

NLINEF ( ILINEF) =IPF 
NSPF( ILINEF) =IPF 
ELSE 

DO 21 J=IPF+1 , LPF+SPLITF ( I ) 

TT .TN FF^ TT , TN EF+1 
NENGF ( ILINEF) =IENGF ( J) 

NTANKF (ILINEF) =ITANKF (I) 
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NLTNEF ( ILINEF) =IPF 
NSPF( ILINEF) =J 

21 CONTINUE 
ENDIF 

IPF=IPF+SPLITF ( I ) +1 

22 CONTINUE 
HJNEO=0 

no=i 

DO 24 I=1,MLINE0 
IF(SPLITO(I) .EQ.0.0) THEN 
TT.TN TTO=TIJNED+l 
NENGO ( TT.TN ED) =IENGO ( IPO) 
NTANKO ( ILINEO) =ITANKO ( I ) 
NLINEO ( ILINEO) =IPO 
NSPO (HINED) =IPO 
ELSE 

DO 23 J=IPO+l , IPCH-SPLITO ( I ) 
TT .TN m=TT .TNEO+1 
NENGO ( ILINEO) =IENGO ( J) 
NTANKO (ILINEO) =ITANKO (I) 
NLINEO ( ILINEO) =IPO 
NSPO ( ILINED) =J 

23 CONTINUE 
ENDIF 

iPO=iPo+spLno (i) +i 

24 CONTINUE 

25 CONTINUE 

IF (ILINEF. EQ.l) THEN 
IPLOTF=l 


26 

27 


WRITE (*,*) 1 Hie following FUEL lines may be plotted' 
WRITE(*, ' (/' 1 Line # Tank # Engine #' '/) ') 

DO 26 1=1, ILINEF 

WRITE(*, ' (15,110,111) ' ) I,NTANKF(I) ,NENGF(I) 
CONTINUE 


CONTINUE ... _ _ . 

WRITE (*, ' (/' 1 Enter line # to be plotted, 0 will end plot 

READ(*, *) IPLOTF 
IF(IPLOTF.LE.O) RETURN 
IF ( IPLOTF. GT. ILINEF) THEN 

WRITE(*,*) ' You did not enter a valid line #. Try again 
GO TO 27 
ENDIF 
ENDIF 

K=NENGF( IPLOTF) 

IF (ILINEO. EQ.l) THEN 
IPLOTO=1 
ELSE 

WRITE (*,*) ' The following LOX lines may be plotted' 
WRITE(*, ' (/ " Line# Tank# Engine#"/)') 

NOXY=0 


DO 28 1=1, ILINEO 
IF(NENGO(I) .NE.K) GO TO 28 


M \)') 
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WRITE(* # ' (15,110,111) ' ) I,NTANKO(I) ,NENGO(I) 

NOXY=NOXY+l 

NOXYP=I 

28 OONTIMJE 
IF(NOXY.BQ.l) THEN 

IPLDTO=NOXYP 

ELSE 

29 CONTINUE 

WRITE(*, ' ' Enter line # to be plotted, 0 will end plot * 1 \) * ) 

READ(*, *) IPLOTO 

IF ( IPLOTO. LE.O) RETURN 

IF ( IPLOTO. GT.ILINEO. OR. NINGO( IPLOTO) .NE.K) THEN 

Vjrxte(*,*) • You did not enter a valid line #. Try again' 

GO TO 29 
ENDIF 
ENDIF 
ENDIF 

CALL SETPLT 
J=NSPF ( IPLOTF) 

I=NLINEF ( IPLOTF) 

K=0 

SEX2-1N=0 

SEX31N=SBGMN+SEGMNF ( I ) 

REWIND 16 

READ ( 16) PIPE1F , PIPE2F , PIPE3F , PIPE4F , PIPE5F 
DO 30 L=1,SEGMNF(I) 

K=K+1 

SECIN (K) =SECINF (L, I) 

PIPE1 (K) =PIPE1F (L, I) 

PIPE2 (K) =PIPE2F (L, I) 

PIPED (K) =PIPE3F (L, I) 

PIPE4 (K)=PIPE4F(L,I) 

30 CONTINUE 
IF(I.NE.J) THEN 

SEX31N=SE)GMN+SEGMNF ( J) 

DO 31 L=1,SEX3WF(J) 

K=K+1 

SECIN (K) =SECINF (L, J) 

P3PE1 (K) =PIPE1F (L, J) 

PIPED (K) =PIPE2F(L, J) 

PIPED (K) =PIPE3F (L, J) 

PIPE4 (K) =PIPE4F (L, J) 

31 CONTINUE 
ENDIF 

CALL PIPPIOT (SEGMN, SECIN, PIPE1 , PIPED , PIPED , PIPE4 , HOX, 

* NTANKF ( IPLOTF) , NENGF ( IPIOTF) , 'A' ) 

J=NSPO( IPLOTO) 

I=NLINEO (IPLOTO) 

K=0 

SEJ31N=0 

SEGMN=SEGMN+SB31NO ( I ) 

REWIND 15 

READ ( 15 ) PIPE1F , PIPED F, PIPED F, PIPE4F, PIPE5F 
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DO 32 L=l,SEGMNO(I) 

K=K+1 

SECTN (K) =SECTNO (L, I ) 

PIPE1 (K) =PIPE1F (L, I) 

PIPE2 (K) =PIPE2F (L, I ) 

PIPE3 (K) =PIPE3F (L, I) 

PIPE4 (K) =PIPE4F (L, I) 

32 CONTINUE 
IF(I.NE.J) THIN 

SEGMN=SEEMN+SE®1N0 ( J) 

DO 33 L=l,SEGMNO(J) 

K=K+1 

SECIN (K) =SECINO (L, J) 

PIPE1 (K) =PIPE1F (L, J) 

PIPE2 (K)=PIPE2F(L, J) 

PIPE3 (K) =PIPE3F (L, J) 

PIPE4 (K) =PIPE4F (L, J) 

33 CONTINUE 
ENDIF 

CALL PIPPLOT ( SEGMN , SECIN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , HOX , 

* NTANKO ( TPL0TO ) ,NENGO(IPLOTO) , 'B') 

IF(ILINEF.EQ. l.AND. ILINEO.EQ. 1) RETURN 

GO TO 25 

END 

LOGICAL FUNCTION f ourcolors ( ) 

C Determines type of graphics monitor 

INCLUDE 'FGRAPH.FD' 

INTEGER*2 dummy 

RECORD /videoconfig/ screen 
COMMON screen 

CALL getvideoconf ig ( screen ) 

SELECT CASE( screen. adapter ) 

CASE( $GGA, $OCGA ) 

dummy = setvideomode ( $MRES4COIDR ) 

CASE( $EGA ; $OEGA ) 

dummy = setvideomode ( $ERESOOLOR ) 

CASE( $VGA, $OVGA ) 

dummy = setvideomode ( $VRES16COLOR ) 

CASE DEFAULT 
dummy = 0 
END SELECT 

CALL getvideoconf ig( screen ) 
f ourcolors = .TRUE. 

IF( dummy .EQ. 0 ) four colors = .FALSE. 

END 

SUBROUTINE FPLOT(HOX) 

C Determines fuel line to be plotted 

COMMON /EPARAM/MENG,TFL0W(25) ,PCHMB(25) ,DPROR(25) ,EMRAT(25) 
INTEGER SEGMNF(25) ,SECINF(75,25) ,NOLINF(25) ,IENGF(25) ,ITANKF(25) , 

* LOPOLF(25) ,L0PENF(25) 

REAL KMANF(25) ,KTANKF(25) ,LFL0WF(25) ,LF(75,25) 

COMMON /FPARAM/MLINEF,SPLITF(25) ,AF(25) ,CMANF(25) ,CTANKF(25) , 

* DENSF(25) ,KMANF,KTANKF,LFLCWF / VOLF(25) ,VOIMFF(25) , 
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* AREAF(75,25) ,DIAF(75,25) ,LF,PINDF(75,25) , 

* PCAPF(75,25) ,AVGKF(25) , 

* SEGMNF , SECINF , NOLINF , IENGF , ITANKF , LOPOLF , LOPENF 
COMMON /F0PIPE/PIPE1F (75,25) ,PIPE2F(75,25) ,PIPE3F(75,25) , 

* PIPE4F(75,25) ,PIPE5F(75,25) 

INTEGER SEGMN, SECTN ( 150) 

COMMON /SETUP/PIPE1 ( 150) , PIPE2 ( 150) , PXPE3 ( 150) , PIPE4 ( 150) , 

* NENGF(25) ,NTANKF(25) ,NUNEF(25) ,NSPF(25) , ILINEF, 

* NENGO(25) ,NIANKO(25) ,NLINEO(25) ,NSPO(25) ,ILINEO, 

* SBGMN, SECIN 
TT.TNFF=Q 


IPF=1 

DO 22 I=1,MLINEF 
IF(SPLTTF(I) .EQ.0.0) THEN 
ilinef=ilinef+i 

NENGF ( TT.TN EF) =IENGF ( IPF) 
NTANKF ( ILINEF) =ITANKF ( I ) 
NLINEF ( TT.TN EF) =IPF 
NSPF (ILINEF) =IPF 
ELSE 

DO 21 J=IPF+1 , IPF+SPLITF ( I ) 
TT ,TN EF=TT .TNEF+1 
NENGF ( TT.TNEF) =IENGF ( J) 
NTANKF (ILINEF) =ITANKF(I) 
NLINEF ( TT.TN EF) =IPF 
NSPF ( ILINEF) =J 

21 CONTINUE 
ENDIF 

IPF=IPF+SPLITF ( I ) +1 

22 CONTINUE 

23 CONTINUE 

IF (ILINEF. EQ.l) THEN 
IPLOTF=l 


24 

25 


ELSE _ 

WRITE (*, *) 1 Tire following FUEL lines may be plotted 

WRITE (*,'(/ 1 1 Line # Tank # Engine # ' ' / ) 1 ) 

DO 24 1=1, ILINEF 

WRITE(*, 1 (15,110,111) ' ) I,NIANKF(I) ,NENGF(I) 

CONTINUE 

CONTINUE _ , ...... 

WRiTE(*, ' (/" Enter line # to be plotted, 0 will end plot \) ) 

READ ( * , *) IPLOTF 
IF(IPICTF.LE.O) RETURN 
IF (IPLOTF. GT. ILINEF) THEN 

WRITE(*,*) 1 You did not enter a valid line #. Try again 
GO TO 25 
ENDIF 
ENDIF 

CALL SETPLT 
J=NSPF (IPLOTF) 

I=NLINEF ( IPLOTF) 

K=0 


SEGMN=0 


72 


SEGMN=SEGMN+SEGMNF ( I ) 

REWIND 16 

READ ( 16 ) PIPE1F , PIPE2F , PIPE3F , PIPE4F, PIPE5F 
DO 26 L=1,SEGMNF(I) 

K=K+1 

SECIN (K) =SECINF (L, I) 

PIPE1 (K) =PIPE1F (L, I) 

PIPE2 (K) =PIPE2F (L, I) 

PIPE3 (K)=PIPE3F(L,I) 

PIPE4 (K) =PIPE4F (L, I) 

26 CONTINUE 
IF(I.NE.J) THEN 

SE31N=SEayiN+SEMNF ( J) 

DO 27 1^1 , SEGMNF ( J) 

K=K+1 

SECIN (K) =SECINF (L, J) 

PIPE1 (K) =PIPE1F (L, J) 

PIPE2 (K) =PIPE2F (L, J) 

PIPE3 (K) =PIPE3F (L, J) 

PIPE4 (K) =PIPE4F (L, J) 

27 CONTINUE 
ENDIF 

CALL PIPPLOT ( SEXMN , SECIN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , HOX , 
* NIANKF(IPLOTF) ,NENGF(IPICrrF) , ’A’) 

IF(ILINEF.EQ.l) RETURN 
GO TO 23 
END 

SUBROUTINE LABANG(XMIN ; XMAX / YMIN, YMAX) 

C Labels phase angle plot 

INCLUDE 'FGRAPH.FD' 

RECORD /WXYCOORD/XY 
RECORD /videoconfig/ screen 

CCMMON screen 

CHARACTER*40 TITLE 
CHARACTER*20 TTILF 
INTEGER* 2 IHR,IMIN,IYR,IMON,IDAY 
CHARACTER* 2 AP 

CCMMON /WCATIT/TITLE,TITLF, IHR, IMIN, AP, IYR, IMON, IDAY 

CCMMON /NOCOL/NCOLS , NMODE 

CCMMON /FACTOR/ SFAC 

INTEGER* 2 NCOLS 

INTEGER* 2 row, rows 

INTEGER*2 DUMWIL 

RECORD /RCCOORD/ S 

REAL* 8 XMIN, XMAX, YMIN, YMAX, XP, YP 
CHARACTER* 6 YLO, YHI 
CHARACTER*7 XHI 
DATA YLO/' -180°'/ 

DATA YHI/' 180°'/ 

1 FORMAT (F7.1) 

2 FORMAT (F7. 2) 

3 FORMAT (F7. 3) 

4 FORMAT (F7. 4) 


- 73 


5 FORMAT (F7. 5) 

6 FORMAT (F7. 6) 

rows = screen . nuintextrows 
IF(NM0DE.BQ.6) THEN 
CALL settextposition( 1, 1, s) 

ELSE 

CALL settextposition( 0, 20, s) 

ENDIF 

CALL OUITEXT (TITLE) 

dummy = rectangle_w( $GBORDER, XMIN, YMIN, XMAX, YMAX ) 
row=rows/4 

CALL SEi'I'EXTPOSmON (row, 1 , s) 

IF(NOOLS.LE.40) THEN 
CALL OUITEXTC Angle') 

ELSE 

CALL OUITEXT(' Phase Angle') 

ENDIF 

IF(NMODE.EQ.6) THEN 
CALL SEITEXTROSITION (rows/2-1, 18, S) 

CALL OUITEXT('freq') 

ELSE 

CALL SETTEXTPOSrnON (rows/2-1, 35, s) 

IF(SFAC.EQ.l.O) THEN 
CALL OUITEXT ( ' Frequency - rad/sec' ) 

ELSE 

CALL OUITEXT ( 'Frequency - Hertz ' ) 

ENDIF 

ENDIF 

CALL GEITEXTPOSmON(s) 

IF(NM0DE.EQ.6) THEN 
CALL SETTEXTPOSrnON ( 3, l,s) 

CALL OUITEXT (YHI) 

CALL SEITEXTPOSnTON (s. row-3, 1,S) 

CALL OUITEXT (YLO) 

CALL GETTEXTPOSITION(s) 

noc=4 

IMAX=26 

ELSEIF(NMODE.EQ.16) THEN 
CALL SETTEXTPOSrnON ( 2 , 10 , s) 

CALL OUITEXT (YHI) 

CALL SEITEXTPOSmON (s. row-2, 10, s) 

CALL OUITEXT (YID) 

CALL GETTEXTPOSITION (s) 

LLOC=13 

IMAX=54 

ELSE 

CALL SETTEXTPOSrnON ( 2 , 10 , s) 

CALL OUITEXT (YHI) 

CALL SEITEXTPOSmON (s. row-2, 10, s) 

CALL OUITEXT (YLO) 

CALL GETTEXTPOSITION (s) 

H0O13 

IMAX=54 
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INDIF 

ILOXMIN 

IHI=XMAX 

idel=imax/ (ihi-ilo) 

rcw=s . row+1 
DO 21 I=ILO, IHI 

m=io.o**i 

IF(HI.GE.O.l) THEN 
WRITE (XHI,1) HI 
ELSEIF (HI. GE. 0.01) THEN 
WRITE (XHI , 2 ) HI 
ELSEIF (HI. GE. 0.001) THEN 
WRITE (XHI, 3) HI 
ELSEIF (HI. GE. 0.0001) THEN 
WRITE (XHI, 4) HI 
ELSEIF (HI. GE. 0.00001) THEN 
WRITE (XHI, 5) HI 
ELSE 

WRITE (XHI, 6) HI 
ENDIF 

CALL SETTEXIPOSITION (rcw , HOC , s) 

CALL OUITEXT(XHI) 

ID0C=ILOC+IDEL 

IF(I.EQ.IDO.OR.I.EQ.IHI) GO TO 21 
CALL SETLINESTYLE (62268) 

XP=I 

YP=YMIN 

CALL MOVETO_W (XP , YP , XY) 

YP=YMAX 

DUMWIL=LINETO_W (XP, YP) 

CALL SETLINESTYLE (65535) 

21 OCaJITNUE 
RETURN 
END 

SUBROUTINE LABGAIN(XMIN,XMAX, YMIN, YMAX,ITYPE) 

C Labels gain plot 

INCLUDE 'PGRAPH.FD' 

RECORD /WXYCOORD / XY 

RECORD /videoconfig/ screen 

COMMON screen 

CHARACTER* 40 TITLE 

CHARACTER* 20 TTTLF 

INTEGER* 2 ihr,imin,iyr,imon,iday 

CHARACTER*2 AP 

COMMON /WCATIT/TTrLE, TTTLF, IHR, DON, AP, IYR, IMON, IDAY 

COMMON /NOOOL/NCOLS , NMODE 

OCMMON / FACTOR/ SFAC 

INTEGER* 2 NCOLS 

INTEGER* 2 row, rows 

INTEGER* 2 DUMWIL 

REOORD/RCCOORD/ S 

REAL* 8 XMIN, XMAX, YMIN, YMAX, XP, YP 
CHARACTER*6 YLO, YHI 
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CHARACTER*? XHI 

1 FORMAT (F7. 1) 

2 FORMAT ( F7 • 2 ) 

3 FORMAT (F7. 3) 

4 FORMAT(F7.4) 

5 FORMAT (F7. 5) 

6 FORMAT (F7. 6) 

7 FORMAT (F6. 3) 

rows = screen . nunrtextr ows 

dummy = rectangle_w ( $GBORDER, XMIN, YMIN, XMAX, YMAX ) 
rcw=rows/4 

CALL SETTEXTPOSITTON (row , 5 , s) 

CALL OUITEXTC Gain ') 

IF(NMODE.EQ.6) THEN 
CALL SETTEXTPOSnTON (rows/ 2-1 , 18 , s) 

CALL OUITEXT ( 1 f req ' ) 

CALL SETTEXTPOSITTON (rows , 16 , s) 

ELSE 

CALL SETTEXTROSmON ( rows/ 2-1 , 35 , s) 

IF(SFAC.EQ.l.O) THEN 
CALL OUITEXT ( 'Frequency - rad/sec') 

ELSE 

CALL OUITEXT ( 'Frequency - Hertz ' ) 

ENDIF 

CALL SETTEXTPOSITTON (rows, 39, s) 

ENDIF 

IF(ITYPE.EQ.l) CALL OUITEXTC K(jw) ') 

IF(ITYPE.EQ.2) CALL OUITEXT (' K(jw,Gox) ') 

IF(ITYPE.EQ.3) CALL OUITEXTC K(jw,Gf) ') 

IF(ITYPE.EQ.4) CALL OUrTEXT('K( jw,Gox,Gf) ') 

WRrTE(YLO,7) YMIN 

WRITE (YHI, 7) YMAX 

CALL GEITEXTPOSmON(s) 

IF(NMODE.E]Q. 6) THEN 

CALL SLTTEXTPOSmCN(3, l,s) 

CALL OUITEXT (YHI) 

CALL SETTEXTPOSnTON ( s . row-3 , 1 , s) 

CALL OUITEXT (YLO) 

CALL GEITEXTPOSrnON(s) 

IL0C=4 

IMAX=26 

ELSETF (NMODE . E3Q . 16 ) THEN 
CALL SETTEXTPOSnTON ( 3 , 10 , s) 

CALL OUITEXT (YHI) 

CALL SETTEXTPOSmON (s. row-4, 10, s) 

CALL OUITEXT (YLO) 

CALL GLTTEXTPOSmON (s) 

IL0C=13 

IMAX=54 

ELSE 

CALL SEITEXTPOSmON ( 2 , 10 , s) 

CALL OUITEXT (YHI) 

CALL SEITEXrPOSITTON (s. row-3, 10, S) 
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CALL OUITEXT(YID) 

CALL GEITEXTPOSmON(s) 

1X00=13 

IMAX=54 

ENDIF 

ihi=xmax 

3 DELr=IMAX/ (im-no) 
row=s.row+l 
DO 21 I=HO, IHI 
HI=10 . 0**1 
IF(HI.GE.O.l) THEN 
WRITE (XHI,1) HI 
ELSEIF(HI.GE.O.Ol) THEN 
WRITE(XHI,2)HI 
ELSEIF(HI.GE. 0.001) THEN 
WRITE (XHI, 3) HI 
ELSEIF(HI.GE. 0.0001) THEN 
WRITE (XHI, 4) HI 
ELSEIF (HI. GE. 0.00001) THEN 
WRITE (XHI ,5) HI 
ELSE 

WRITE (XHI, 6) HI 
ENDIF 

CALL SEITEXTPOSmON (row, HOC, s) 

CALL OUETEXT(XHI) 

hoc=hoc+idel 

IF(I.EQ.HO.OR.I.EQ.IHI) GO TO 21 
CALL SETLINESTYLE( 62268) 

XP=I 

YP=YMXN 

CALL MOVEIO_W(XP,YP,XY) 

YP=YMAX 

DUMWIl>LINErO_W (XP , YP) 

CALL SETLINESTYLE( 65535) 

21 CONTINUE 
RETURN 

END mTV 

SUBROUTINE IOWERW(XMIN,XMAX, YMAX, YMIN) 

C Sets up lower plotting window 

INCLUDE 'PGRAPH.FD' 

INTEGER* 2 dummy 

INTEGER* 2 xwidth, yheight, cols, tcms 

RECORD /videoconfig/ screen 
COMMON screen 

COMMON /NOCOL/NCOLS , NMODE 
INTEGER* 2 NCOLS, NMODE 

REAL*8 XMIN, XMAX, YMIN, YMAX, XLEN, YLEN 
XLEN=0 . 1* (XMAX-XMIN) 

YLEN=0 . 1* (YMAX-YMIN) 

XMIN=XMIN-XLEN 

XMAX=XMAX+XLEN 

YMIN=YMIN-YLEN 
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c 


YMAX=YMAX+YLEN 

xwidth = screen. numxpixels 

yheight = screen. numypixels 

cols = screen, nunttextcols 

rows = screen . numtextrows 

IF(NMODE.EQ. 6) THEN . 

CALL setviewport ( 50, yheight - 30, xwidth - 20, 10 ) 

ELSE 

CALL setviewport ( 100, yheight - 50, xwidth - 50, 40 ) 
ENDIF 

CALL settextwindow ( 0, 1, rows, cols) 

dummy = setwindow(.TRUE. ,XMIN,YMIN,XMAX,YMAX) 

CALL clearscreen ( $GW3ND0W ) 


REIURN 

END 

SUBROUTINE LPLOT(ILOX) 

Determines lox line to be plotted 
COMMON /EPARAM/MENG,TFLCW(25) ,PCHMB(25) ,DPROR(25) ,FNRAT(25) 
INTEGER SBGMNO(25) ,SECINO(75,25) ,NOUNO(25) ,IENGO(25) ,ITANKO(25) , 

* LOPOLO(25) ,IOPENO(25) 

REAL KMANO(25) ,KIANKO(25) ,LFLCW0(25) ,10(75,25) 

COMMON /OPARAM/MLINEO,SPLITO(25) ,AO(25) ,CMANO(25) ,CIANKO(25) , 

* DENSO (25) ,KMANO,KTANKO,LFLCWO,VOLO(25) ,VOLMFO(25) , 

* AREAO(75, 25) ,DIAO(75,25) ,I0,PINDO(75, 25) , 

* PCAPO(75,25) ,AVGKO(25) , 

* SEX3WO , SECINO , NOLINO , IENGO , ITANKO , LOPOIO , LOPQTO 
COMMIT /F0PIPE/PIPE10(75,25) ,PIPE20(75,25) ,PIPE30(75,25) , 

* PIPE40(75, 25) ,PIPE50(75,25) 

INTEGER SEGMN,SECTN(150) 

COMMON /SETUP/PIPE1 (150) ,PIPE2(150) ,PIPE3(150) ,PIPE4(150) , 

* NENGF(25) ,NTANKF(25) ,NLINEF(25) ,NSPF(25) ,IUNEF, 

* NINGO(25) ,NTANKO(25) ,NLINE0(25) ,NSPO(25) ,ILINEO, 

* SBGMN.SECIN 


TT.TNBP=0 

IPO=l 

DO 22 I=1,MLINE0 
IF(SPLITO(I) .EQ.0.0) THIN 
TT ,TN fn= TT TN ECH-1 
NENGO ( ILINEO) =IENGO ( IPO) 
NIANKO ( ILINEO) =ITANKO ( I ) 
NLINB0 ( ILINEO) =IPO 
NSPO ( ILINB0) =IPO 
ELSE 

DO 21 J=IPO+l , IPO+SPLITO ( I ) 
IT ,T>TR-)=TT .TNFP+1 
NENGO (ILINEO) =IENGO ( J) 
NTANKO ( ILINEO) =ITANKO ( I ) 
NLINEO ( ILINEO) =IPO 
NSPO ( ILINEO) =J 

21 CONTINUE 
ENDIF 

uo=ipo+splito ( i ) +1 

22 CONTINUE 
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23 CONTINUE 
IF(nJNBO.EQ.l) THEN 

IPDOTOl 

ELS E 

WRITE (*,*) ' The following LOX lines nay be plotted' 

WRITE(*, 1 (/ 1 ' Line# Tank# Engine #''/)' ) 

DO 24 1=1 , TT iTNBO 

WRITE(*, ' (15,110,111) ' ) I,NTANKO(I) ,NENGO(I) 

24 CONTINUE 

25 CONTINUE , . , . ...... 

WRTTE(*, ' (/' ' Enter line # to be plotted, 0 will end plot \) ) 

READ(*, *) IPLCTO 
IF(IPLOTO.LE.O) RETURN 
IF ( IPLCTO. GT. ILLNEO) THEN 

WRITE(*,*) ' You did not enter a valid line #. Try again 
GO TO 25 
ENDIF 
ENDIF 

CALL SEIPLT 
J^SPO (IPLCTO) 

I=NLINB0 ( IPLCTO) 

K=0 

SEGMN=0 

SEEMN=SEXM^+SEX3LN0 ( I ) 

REWIND 15 

READ ( 15 ) PIPEIO , PIPE20 , PIPE30 , PIPE40 , PIPE50 
DO 26 L=l,SEGMNO(I) 

K=K+1 

SECIN (K) =SECLNO (L, I) 

PIPE1 (K) =PIPE10 (L, I) 

PIPE2 (K) =PIPE20 (L, I) 

PIPE3 (K) =PIPE30 (L, I) 

PIPE4 (K) =PIPE40 (L, I) 

26 CONTINUE 
IF(I.NE.J) THEN 

SBGMN=SEGIMN+SEGMNO ( J) 

DO 27 L=l,SEGMNO(J) 

K=K+1 

SECIN (K)=SECINO(L,J) 

PXPE1 (K) =PIPE10 (L, J) 

PXPE2 (K) =PIPE20(L, J) 

PIPE3 (K) =PIPE30 (L, J) 

PIPE4 (K) =PIPE40 (L, J) 

27 CONTINUE 
ENDIF 

CALL PIPPLCT ( SEGMN , SECIN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , HCX , 

* NTANKO ( IPLCTO) ,NENGO (IPLCTO) , 'B') 

IF(ILINEO.EQ* 1) RETURN 

GO TO 23 

IM) 

SUBROUTINE NICE3GRF(RMIN,RMAX,IMAX,IMMIN,ITYPE) 

Plots Nyquist curve 
INCLUDE 'FGRAPH.FD' 
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RECORD /videoconfig/ screen 
COMMON screen 

CHARACTER* 40 TITLE 
CHARACTER*20 TITLF 
INTEGER* 2 3HR,IMIN,IYR,IM0N,IDAY 
CHARACTER* 2 AP 

COMMON /WCATIT/TITLE,TITLF,IHR, IMIN,AP,rYR, IMON, IDAY 
COMMON /NOCOL/NCOLS , NMODE 
COMMON / FACTOR/ SFAC 
INTEGER* 2 NCOLS, NMODE 
INTEGER* 2 row, rows 
REOORD/RCCOORD/ S 
REAL*8 IMMIN, IMAX,RMIN,RMAX 
REAL* 8 XMIN, XMAX, YMIN, YMAX 
CHARACTER* 6 YLO, YHI,XLO,XHI 
1 FORMAT (F6. 3) 

rows = screen, numtextrows 

XMIN=RMrN 

XMAX=RMAX 

ymin=immin 

YMAX=IMAX 

IF (NMODE. EQ. 6) THEN 
CALL settextposition( 0, 1, s) 

CALL OOTTEXT (TITLE) 

ELSE 

CALL settextposition( 0, 20, s) 

CALL OUITEXT (TITLE) 

ENDIF 

dummy = rectangle_w( $GBORDER, XMIN, YMIN, XMAX, YMAX ) 
row=rows/2 

CALL SEITEXTPOSmON (row , 1 , s) 

IF (NMODE. EQ. 6) THEN 
CALL OUITEXT ('Imag') 

CALL SEJITEXTPOSrnON (rows-1 , 16 , s) 

CALL OUITEXT ( ' Real') 

CALL SEnTEXTPOSITION (rcws , 16 , s) 

ELSE 

CALL OUITEXT ('Imaginary') 

CALL SETTEXTPOSITTCN (rows-1, 39, s) 

CALL OUTTEXT ( ' Real') 

CALL SEITEXTPOSmON (rcws , 39 , s) 

ENDIF 

IF(ITYPE.EQ.l) CALL OUITEXT(' K(jw) ') 
IF(ITYPE.EQ.2) CALL OUITEXT ( ' K(jw,Gox) ') 
IF(ITYPE.EQ.3) CALL OUl'i'EXT ( ' K(jw,Gf) ') 
IF(ITYPE.EQ.4) CALL OUITEXT ( 'K( jw,Gox,Gf) ' ) 

WRITE (YLO, 1) YMIN 
WRITE (YHI, 1) YMAX 
WRITE (XIO, 1) XMIN 
WRITE (XHI,1) XMAX 
CALL GETTEXTPOSmON(s) 

IF(NM0DE.EQ.6) THEN 
CALL SEITEXTPOSITTON ( s . row-3 , 1 , s) 
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c 


CALL OUITEXT(YID) 

CALL GEITEXrPOSrnON (s) 

CALL SETTEXTPOSITION ( s . row+1 , 4 , s) 
CALL OUITEXT(XLjO) 

CALL GETTEXTPOSITTON ( s ) 

CALL SEITEXrPOSrnON (s . row , 35 , s) 
CALL OUITEXT(XHI) 

CALL SETTEXTPOSITION (4 ,l,s) 

CALL OUITEXT(YHI) 

ELSE 

CALL SETTEXIPOSITTON ( S . row-3 , 5 , S) 
CALL OUITEXT(YLO) 

CALL GEITEXTPOSnTON ( s ) 

CALL SEITEXTPOSITTON(s.row+l,9,s) 

CALL OUITEXT(XLO) 

CALL GEITEXTPOSnTON (s) 

CALL SEITEXTPOSinON(s.raw,71,s) 

CALL OUTTEXT(XHI) 

CALL SEITEXTPOSinON(3,5,s) 

CALL OUITEXT(YHI) 

ENDIF 

RETURN 


SUBROUTINE PIPPLOT ( SEGMN , SECIN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , ILOX , 
r ITANK, IENG,R) 

Supervises plot of piping layout 
INCLUDE 'FGRAPH.FD' 

REOORD/WXYCOORD/XY 
INTEGER* 2 DUMWTL 

COMMON / ARCCON/XC , YC , RAD , ANG , ANGLE 

COMMON /PIPPXY/X,XH,XL, Y, YH, YL,XMIN,XMAX, YMIN, YMAXjSINA, COSA 

INTEGER* 2 SEGMN, SECIN (75) ,ITYPE(200) 

REAL PIPE1(75) ,PIPE2(75) ,PIPE3(75) ,PIPE4(75) 

REAL* 8 X0,X1,X2,X3,Y0,Y1 > Y2,Y3 

COMMON /WORK2/ POINT(8,200) ,DUMMY3 (175) ,ITYPE 
CHARACTER*! R 


ANG=0.0 
ANGLB=0.0 
C0SA=1.0 
SINA=0 . 0 


X=0.0 
XH=0. 0 
XL=0. 0 
Y=0. 0 

IF(SECTN(1) .EQ.O) THEN 
YH=Y+0.5*PIPE3(1) 

YL=Y-0 . 5*PIPE3 ( 1) 

ELSEIF (SECIN (1) .GE.3.AND.SECIN(1) .LE.5) THEN 
IF(SECIN(2) .EQ.O) THEN 
YB=Y+0.5*PIPE3(2) 

YLf=Y-0 . 5*PIPE3 ( 2 ) 


ELSE 

YH=Y+0 . 5*PXPE2 ( 2 ) 
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c 


c 


c 


c 


c 


c 


c 


c 


YL=Y-0.5*PIPE2(2) 

ENDIF 

ELSE 

YH=Y+0 . 5*PIPE2 ( 1) 
YL=Y-0 . 5*PLPE2 (1) 
ENDIF 


J=0 

XMIN=0.0 


XMAX=0. 0 


YMINNAMIN1 (Y,YL,YH) 
YMAX=AMAX1(Y,YL,YH) 

DO 21 1=1, SEGMN 
IF(SECIN(I) .EQ.O) THEN 


CALL BNSECT ( J , ITYPE , POINT , PIPE1 ( I ) ,PIPE2(I) ,PIPE3 (I) ,PIPE4(I) 
ELSEIF(SECIN(I) .EQ.l) THIN 
straight section 

CALL STSECT(J, ITYPE, POINT, PIPE1(I),PIPE2 (I)) 

ELSEIF(SECIN(I) .EQ.2) THEN 
inline accumulator 

CALL STSECT(J, ITYPE, POINT, PIPEl(I) ,PIPE2 (I) ) 

ELSEIF(SECIN(I) .EQ.3) THEN 
tuned stub accumulator 

CALL TSSECT(J, ITYPE, POINT, PIPE1 (I) ,PIPE2(I) ) 

ELSEIF(SECIN(I) .EQ.4) THEN 


helmholtz resonator 
CALL HHSECT f J , ITYPE , POINT , PIPE1 ( I) 


,PTPE2fI^ .PIPE3 (I) ) 


EXSEIF (SECTN (I) .EQ.5) THEN 
parallel resonator 

CALL PLSECT(J, ITYPE, POINT, PIPEl(I) ,PIPE2(I) , PIPES 
ELSEIF(SECTN(I) .EQ.6) THEN 


(I) 


) 


) 


CALL STSECT (J, ITYPE, POINT , PIPE1 (I) ,PIPE2(I)) 
ENDIF 

21 CONTINUE 

XRANGE=XMAX-XMIN 
YRANGE=YMAX-YMIN 
XMIN=XMIN-0 . 05*XRANGE 
XMAX=XMAX+0 . 05*XRANGE 
YMIN=YMIN-0 . 05*YRANGE 
YMAX=YMAX+0 . 05*YRANGE 

CALL UPPERW(XMIN,YMIN,XMAX,YMAX,IIOX,ITANK,IENG,R) 

DO 22 1=1, J 

IF(ITYPE(I) .EQ.O) THEN 
bend 

XC=POINT(l,I) 

YC=POINT(2,I) 

Xl=POINT(3,I) 

Yl=POINT(4, I) 

RAD=POINT (5,1) 

IF(Xl.GT.Yl) THEN 
Xl=3 . 14159+X1 
Yl=3 . 14159+Y1 
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c 


c 


CALL CUKV(Y1,X1) 

ELSE 

CALL CURV (XI, Yl) 

ENDIF 

ELSE 

all except bend 
XO=POINT (1,1) 
Y0=P0INT(2,I) 

X1=P0INT(3 , I) 
Y1=P0INT(4,I) 
X2=POINr(5,I) 
Y2=POINT(6,I) 

X3=POLNT(7 ,1) 
Y3=POINT(8, I) 

CALL MOVETO_W (XO , YO , XY) 
DUMWIL=LINErO_W (XI , Yl) 
CALL MOVErO_W(X2,Y2,XY) 
DUMWIL=LINETO_W (X3,Y3) 
CALL MOVETO_W (XO , YO , XY) 
DUMWILfLENETO_W (X2,Y2) 
CALL MOVEIO_W (XI , Yl , XY) 
DUMWIL=LINErO_W (X3,Y3) 


ENDIF 

22 CONTINUE 

IF(R.EQ. 'A') THEN 
IF(ILOX.EQ.O) RETURN 
ENDIF 

CALL ENDPLT 

RETURN 

END 

SUBROUTINE PLSECT(J, TTYPE, POINT, LEN,DIA, VOL) 

Computes plot coordinates for parallel resonator 

OOMMON /PIPPXY/X,XH,XL,Y,YH,YL,XMIN,XMAX,YMIN / YMAX,SINA / OOSA 

COMMON /ARCCON/XC , YC , RAD , ANG , ANGLE 
REAL LEN, POINT (8, 200) 

INTEGER* 2 ITYPE(200) 


XOU>X 

XHOLD=XH 

XLOID=XL 

YOLD=Y 

YHOLD=YH 

YLOLD=YL 

ANGOID=ANG 

ANGSAV=ANGLE 

SINOLD=SINA 

COSOID=COSA 

DIAM=SQRT( (XH-XL) **2+(YH-YL) **2) 
CALL STSECT ( J , ITYPE , POINT, DIA, DIAM) 
XC=0 . 5* (XHOLEH-XH) 

XHOXHOLD 


XLC=XL 

YC=0.5* (YHOLD+YH) 
YHC=YHOID 
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YLC=YL 

PLEN=LEN-2 . 0*DIA 

PDIA= ( VOL-2 . 0*DIA*DIAM) /PLEN 

CALL STSECT ( J , ITYPE , POINT , PLEN , PDIA) 

CALL STSECT (J, ITYPE, POINT, DIA ; DIAM) 

XSAV=X 

XHSAV=XH 

XLSAV=XL 

YSAV=Y 

YHSAV=YH 

YLSAV=YL 

SINAfOOSOLD 

COSA=-SINOLD 

RADIUS=DIA 

TURN=-90 . 0 

SIDE=LEN-5 . 0*DIA 

ANG=ANG+1 .5708 

ANGLE=ANGLE+9 0 . 0 

x=xc 


Y=YC 

XH=XHC 

XL=XLC 

YH=YHC 

YIf=YLC 

CALL BNSECT(J, ITYPE, POINT, RADIUS, TURN, DIA,DIA) 
CALL STSECT (J, ITYPE, POINT, SIDE, DIA) 

CALL BNSECT(J, ITYPE, POINT, RADIUS, TURN, DIA, DIA) 

X=XSAV 

Y=YSAV 

XH=XHSAV 

XL=XLSAV 

YH=YHSAV 

YL=YLSAV 

ANG=ANGOLD 

ANGLE=ANGSAV 

SINA=SINOLD 

COSA=OOSOLD 


RETURN 

END 

SUBROUTINE PNYQ(KR, KC,KW, PIS, ITYPE, ITF,ITO,ING) 

Plots gain and phase angle 
INCLUDE 'FGRAPH.FD' 


INTEGER PTS 

REAL KR(PTS) ,KC(PTS) ,KW(FTS) 

COMMON /W0RK1/DUMMY2 (8397) ,X(1001) ,YR(1001) ,YC(1001) 


RECORD / WXYOOORD / XY 
RECORD /videoconfig/ screen 


COMMON screen 

RECORD/RCCOORD/ S 

COMMON /NOCOL/NCOLS , NMODE 


INTEGER* 2 DUMWIL 

REAL*8 XMIN,XMAX, YMINR, YMAXR,YMINC,YMAXC,XP ,YP,XLO,XHI 
CHARACTER* 3 8 ENGTNK 
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1 FORMAT (15X, ' \17X) 

2 FORMAT (7X, 'Eng. #' ,I2,3X, 'IOX TANK # ,12, 8X) 

3 FORMAT (7X, 'Eng. #' ,I2,3X, 'FUEL TANK #' ,I2,7X) 

4 FORMAT( 'Eng. #' ,12, 3X, 'FUEL TANK #' ,I2,2X, 'LOX TANK # , ) 

rows = screen. numtextrows 


CALL SETPLT 
DO 21 1=1, FTS 

YR(I)=SQRT(KR(I) **2+KC(I) **2) 

YC(I) =57 . 29578*ATAN2 (KC(I) ,KR(I)) 
X(I)=AL0G10(KW(I) ) 

21 CONTINUE 
YMINR=YR(1) 

YMAXR=YR(1) 

YMINC=-180.0 
YMAXC= 180.0 
XMEN=X(1) 

XMAX=X(1) 

DO 22 1=2, FTS 

IF(X(I) .LT.XMIN) XMIN=X(I) 

IF(X(I) .GT.XMAX) XMAX=X(I) 

IF(YR(I) .LT.YMINR) YMINR=YR(I) 

IF (YR(I) .CT.YMAXR) YMAXR=YR(I) 

22 CONTINUE 
XLD=0.0 
XHI=0.0 

DO 23 I=-10,10 
IF(XMIN.GE.I) XD0=I 
IF(XMAX.LE.I) THEN 
XHI=I 
GO TO 24 
ENDIF 

23 CONTINUE 

24 CONTINUE 

IF(XDD.EQ.XHI) XHI=XHI+1.0 
CALL WINDLO(XLO,XHI, YMINR, YMAXR) 

CALL IABGAIN (XL0,XHI, YMINR, YMAXR, ITYPE) 
IF(ITYPE.EQ.l) WRITE (ENGINK,1) 
IF(ITYPE.EQ.2) WRITE(ENGINK,2)ING,ITO 
IF(ITYPE.EQ.3) WRITE (ENGINK, 3 ) ING, iTF 
IF(ITYPE.EQ.4) WRITE (ENGINK, 4) ING, lTF,ITO 
IF(NMODE.EQ. 6) THEN 
CALL settextposition( ROWS/ 2+1, 1, s) 


ELSE 

CALL settextposition( ROWS/ 2+1, 26, s) 


ENDIF 

CALL OUITEXT (ENGINK) 

CALL SETLINESTYLE (62268) 
IF(XMIN.LE.O.O.AND.XMAX.GE.O.O) THEN 
XP=0.0 


yp=yminr 

CALL MOVETO_W(XP,YP,XY) 
YP=YMAXR 

DUMWID=LINETO W(XP,YP) 
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ENDIF 

IF(YMINR.LE.O.O.AND.YMAXR.GE.O.O) 

YP=0. 0 
XP=XLD 

CALL MOVETO_W(XP,YP,XY) 

XP=XHI 

DUMWIL=LINETO_W (XP , YP) 

ENDIF 

CALL SETLINESTYLE( 65535) 

XP=X(1) 

YP=YR(1) 

CALL MOVETOJW (XP , YP , XY) 

DO 25 1=2, PTS 
XP=X(I) 

YP=YR(I) 

DUMWIL=LINErO_W (XP , YP) 

25 CONTINUE 

CALL WINDUP (XLD , XHI , YMINC , YMAXC) 
CALL LABANG(XLO, XHI, YMINC, YMAXC) 
CALL SETLINESTYLE( 62268) 

IF ( XMIN . LE . 0 . 0 . AND . XMAX . GE . 0 . 0 ) 

XP=0.0 

YP=YMINC 

CALL MOVETOJW (XP , YP , XY) 

YP=YMAXC 

KJMWIL=LINErO_W (XP , YP) 

ENDIF 

IF (YMINC. LE. 0.0. AND. YMAXC. GE. 0.0 
YP=0. 0 
XP=XLO 

CALL MOVETO_W (XP, YP , XY) 

XP=XHI 

IX]MWIL=LINETOJW (XP , YP) 

ENDIF 

CALL SETLENESTYLE (65535) 

XP=X(1) 

YP=YC(1) 

CALL MOVEIO_W (XP , YP, XY) 

DO 26 1=2, PTS 
XP=X(I) 

YP=YC(I) 

DUMWTL=LINErO_W ( XP , YP) 

26 CONTINUE 
CALL ENDPLT 
RETURN 
END 

SUBROUTINE SETPLT 

C Sets up the plot environment 

INCLUDE 'FGRAPH.FD' 

RECORD /videoconfig/ screen 
COMMON screen 

LOGICAL fourcolors 
EXTERNAL fourcolors 


THEN 


THEN 


THEN 


COM MON /NOCOL/NCOLS , NMODE 
INTEGER*2 NCOLS , NMODE 

IF( .NOT.fourcolors() ) THEN . ( 

WRITE (*,*) ' This program requires a CGA, EGA, or , 
+ ' VGA graphics card. ' 

STOP 

INDIF 

NOOLS = screen. numtextcols 

NMODE = screen, mode 

RETURN 
END 

SUBROUTINE UPPERW(X00, YOO,X11,Y11,IIOX,ITANK,IENG,R) 
C Sets up upper plotting window 

INCLUDE 'FGRAPH.FD' 

RECORD /RCOOORD/ S 
INTEGER* 2 dummy 

INTEGER*2 xwidth, yheight, cols, rows 

RECORD /videoconfig/ screen 

COMMON screen 

COMMON /NOCOL/NCOLS, NMODE 

INTEGER* 2 NOOLS, NMODE 

CHARACTER*2 AP 

CHARACTER*40 TITLE 

CHARACTER* 20 TTTLF 

CHARACTER* 3 6 FULOX 

COMMON /WCATTT/TITLE, TTTLF, IHR,IKCN,AP,IYR, DOT, IDAY 
REAL*8 X0, XI, Y0, Y1 
CHARACTER* 1 R 

1 FORMAT ( 1 FUEL Piping - Tank # ',12,' Engine # ,12) 

2 FORMAT ( ' LOX Piping - Tank # ',12,' Engine # ',12) 
xwidth = screen, numxpixels 

yheight = screen . numypixels 

cols = screen. numtextcols 

rows — screen . numtextr ows 

halfy = yheight/ 2 

XO=XOO 

YO=YOO 

X1=X11 

Y1=Y11 

PICX=XWIDIH-2 0 
PICY=HALFY-30 

IF (NOOLS. LE. 40) PICY=HALFY-20 
XRANG=DABS (X1-X0 ) 

YRANG=DABS (Y1-Y0) 

XRAT=PICX / XRANG 
YRAT=PICY / YRANG 
IF (XRAT. LT . YRAT) THEN 
YRAT=PICY/XRAT 
ADDY=0 . 5* (YRAT- YRANG) 

YO=YO-ADDY 

Y1=Y1+ADDY 

ELSE 

XRAT=PICX/YRAT 
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ADDX=0 . 5* (XRAT-XRANG) 

XO=XO-ADDX 

X1=X1+ADDX 

ENDIF 

IF(R .EQ. 'A') THEN 
IF (NM0DE.EQ.6) THEN 

CALL setviewport ( 10, halfy + 10, xwidth - 10, yheight - 10 ) 
dummy = setwindow ( .TRUE., XO— 1.0, YO— 1.0, Xl+1.0, Yl+1.0 ) 
CALL settextwindow ( (rows / 2 ) + 1, 1, rows, cols) 

ELSE 

CALL setviewport ( 10, halfy + 10, xwidth - 10, yheight - 10 ) 
dummy = setwindow ( .TRUE., X0-1.0, Y0-1.0, Xl+1.0, Yl+1.0 ) 
CALL settextwindow ( (rows / 2 ) + 1, 5, rows, cols - 5) 

ENDIF 

CALL clearscreen( $GWINDCW ) 

IF(H-OX.EQ.O) dummy = rectangle_w( $GBORDER, XO, YO, XI, Y1 ) 
IF(NM0DE.EQ.6) THEN 
CALL SEITEXTPOSnTON ( 1 , 1 , S) 

ELSE 

CALL SETTEXIPOSITTON ( 1 , 20 , S) 

ENDIF 

WRITE ( FUIOX , 1 ) ITANK , IENG 
CALL OUITEXT( FULOX) 

ENDIF 

IF(R.E)Q. ’B'.OR.ILOX.EQ.l) THEN 
IF(NMODE.EQ.6) THEN 

CALL setviewport ( 10, 20, xwidth - 10, halfy ) 

dummy — setwindcw ( .TRUE., XO— 1.0, YO— 1.0, Xl+1.0, Yl+1.0 ) 

CALL settextwindow (0 , 1, (rows / 2 ) , cols) 

ELSE 

CALL setviewport ( 10, 25, xwidth - 10, halfy — 5 ) 

dummy = setwindow ( .TRUE., X0-1.0, Y0-1.0, Xl+1.0, Yl+1.0 ) 

CALL settextwindow (0 , 1, (rows / 2 ) , cols - 5) 

ENDIF 

CALL cl earscreen ( $GWINDCW ) 

dummy = rectangle_w( $GBORDER, XO, YO, XI, Y1 ) 

IF(NM0DE.EQ. 6) THEN 
CALL SLTTEXTPOSmON ( 0 , 1 , S) 

ELSE 

CALL SETTEXTFOSITTON (0 , 20 , S) 

ENDIF 

CALL OUITEXT (TITLE) 

IF(NMODE.EQ. 6) THEN 
CALL SETTEXrPOSITTON(2,l,S) 

ELSE 

CALL SEITEXTPOSnTON (2, 20, S) 

ENDIF 

IF(ILOX.EQ.O) THEN 
WRITE (FULOX, 2) nANK, IENG 
CALL OUITEXT (FULOX) 

ENDIF 

ENDIF 

RETURN 
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END 

SUBROUTINE WINDED (XMIN, XMAX, YMIN, YMAX) 

C Sets up gain window 

INCLUDE 'FGRAPH.FD' 

INTEGER* 2 dummy . 

INTEGER*2 xwidth, yheight, cx>ls, rows, hairy 

RECORD /videoconfig/ screen 

COMMON screen 

COMMON /NOCOL/NCOLS , NMODE 

INTEGER* 2 NCOLS 

REAL* 8 XMIN, XMAX, YMIN, YMAX, XLEN, YLEN 
REAL* 8 XMINP, XMAXP, YMINP, YMAXP 
XLEN=0 . 1* (XMAX-XMIN) 

YLEN=0 . 1* (YMAX-YMIN) 

XMINP=XMIN-XLEN 

XMAXP=XMAX+XLEN 

YMINP=YMIN-YLEN 

YMAXP=YMAX+YLEN 

xwidth = screen, numxpixels 

yheight = screen. numypixels 

cols = screen . nurntextcols 

rows = screen . numtextrcws 

halfy = yheight/ 2 

IF (NCOLS. LE. 40) THEN . ^ _ 

CALL setviewport ( 50, halfy + 10, xwidth - 20, yheight 

ELSE . t 

CALL setviewport ( 100, halfy + 10, xwidth - 50, yheight 

END IF . , . 

CALL settextwindow ( (rows / 2 ) + 1, 1, rcws, cols - 1) 
dummy = setwindow( .TRUE. , XMINP, VMINP, XMAXP, YMAXP) 

CALL clear screen ( $GWINDCW ) 

RETURN 

END 

SUBROUTINE WINDUP(XMIN,XMAX, YMIN, YMAX) 

C Sets up phase angle window 

INCLUDE 'PGRAPH.FD' 

INTEGER* 2 dummy 

INTEGER* 2 xwidth, yheight, cols, rcws, hairy 

RECORD /videoconfig/ screen 

COMMON screen 

COMMON /NOCOL/NCOLS, NMODE 

INTEGER* 2 NCOLS 

REAL* 8 XMIN, XMAX, YMIN, YMAX, XLEN, YLEN 
REAL* 8 XMINP, XMAXP, YMINP, YMAXP 
XLEN=0 . 1* (XMAX-XMIN) 

YLEN=0 . 1* (YMAX-YMIN) 

XMINP=XMIN-XLEN 

XMAXP=XMAX+XLEN 

YMINP=YMIN-YLEN 

ymaxp=ymax+ylen 

xwidth = screen. numxpixels 
yheight = screen. numypixels 
cols = screen. nurntextcols 


30 ) 

- 50 ) 
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rows = screen . nurntextrows 

halfy = yheight/2 

IF(NCOLS.LE.40) THEN 

CALL setviewport ( 50, 10, xwidth - 20, halfy - 30 ) 
ELSE 

CALL setviewport ( 100, 10, xwidth - 50 , halfy - 50 ) 
HOIF 

CALL settextwindo w( 1, 1, (rows / 2 ) - 1, cols - 1) 
dummy = setwindcw(.TRUE. ,>MINP,YMINP,XMAXP,YMAXP) 
CALL clearscreen ( $ GWXNDCW ) 

RETURN 

END 
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PROGRAM NYQUIST2 


SUBROUTINE ADMIT(S,GADM,A,AREA,CMAN,CIANK,DPROR,L,LFLOW,I : MRAT, 

* SBGMN, SECIN, SPLIT, LOPEND, PCAP, PIND, IENG,TFLCW, 

* NOLINE, IP, nJNE,ITLIN) 

C Determines admittance looking toward tank 

CHARACTER* 40 TITLE 
CHARACTER*20 TITLF 
INTEGER* 2 mR,IMIN,IYR,IMON,IDAY 
CHARACTER* 2 AP 

rmf fPN /WCATIT/TTILE, TITLF, IHR,IMIN,AP / IYR, DOT, IDAY 
INTEGER SEGMN(25) ,SECIN(75,25) 

INTEGER IENG(25) ,NOLINE(25) 

REAL AREA(75,25) ,PCAP(75,25) ,PIND(75,25) ,L(75,25) ,LFL0W, ZO(75, 25) , 

* CMAN(25) ,DPROR(25) ,FMRAT(25) ,Z0R(25) ,TFI£W(25) 

COMPLEX G(0:75,25) ,ZT(0:75,25) ,ZG(0:75,25) ,GOID(0:75,25) ,GAEM(25) , 

* S, ZGEFF, ZTEFF 
COMMON /W0RK1/G, ZT, ZG 
COMMON /WORK2/ZO 
COMMON /FACTOR/ SFAC 

OCMPLEX CTANH,RHS,CFAC,CAPN,CAFM 
CHARACTER* 13 TYPEL(2) 

DATA TYPEL/' in FUEL line' , ' in LOX line'/ 

DATA GRAV/32.2/ 

DATA IOPEN/O/ 

ZT0P=A / GRAV 
TMASS=0.0 
TOOUNT=0. 0 
DO 22 J=IP , IP+SPLIT 
GOLD (0,J) =0.0 
SECIN (SEXMN ( J) +1 , J) =0 
DO 21 1=1 , SEGMN ( J) 

GOLD (I, J) =0.0 
ZO(I,J)=0.0 

IF (SECIN (I, J) .LE. 2) THEN 
ZO(I , J) =ZTOP/AREA(I , J) 

E^EIF(SECIN(I,J) .EQ.7) THEN 
ZO(I,J)=0.0 
ELSE 

ZO(I,J)=SQRT(PIND(I,J) /PCAP(I, J) ) 

ENDIF 

21 CONTINUE 

IF(IENG(J) .NE.O) THEN 
IE=IENG(J) 

ZOR(J) =2 . 0*DPROR(IE) /LFLOW 
IF(J. EQ. IP. AND. SPLIT. EQ. 0.0) THEN 
TMASS=TFLOW(IE) 

ELSEIF(J.NE.IP) THEN 
TMASS=TMASS+NOLINE ( J) *TFLOW (IE) 

TCOUNT=TCOUNIH-NOLINE ( J) 

ENDIF 

ENDIF 
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22 CONTINUE 

IF(TOOUNT.EQ.O.O) TCOUNT=1.0 
G ( 0 , IP) =CTANK*S 
G ( 0 , IP) =G ( 0 , IP) /TCOUNT 
ZT(0,IP) =1.0/G(0,IP) 

DO 31 KLOOP=l , LOPEND 
DO 25 J=IP , IP+SPLIT 
IF(J.NE.IP) THEN 
G(0,J)=G(SEGMN(IP) ,IP) 

ZT(0, J)=l. 0/G(0, J) 

ENDIF 

DO 24 1=1, SEGMN (J) 

ZGEFF=G ( 1-1 , J) 

IF(SECIN(I,J) .LE.l) THEN 
C bend in pipe or straight section 

IF(KLOOP.NE. 1. AND.SPLIT.NE.O.AND. J.NE.IP.AND. I. EQ. 1) THEN 

ZGEFF=0.0 

DO 23 K=EP+1, IP+SPLIT 
IE=IENG(K) 

IF(K.EQ.J) THEN 

ZGEFF=ZGEFF+ (NOLINE (K) -1.0) /ZG(0,K) 

ELSE 

ZGEFF=ZGEFF+NOLINE(K) /ZG(0,K) 


23 


C 

C 

C 

C 

C 


ENDIF 

CONTINUE 

ZGEFF=G(SE£MN (IP) , IP) +ZGEFF 
ENDIF 

G(I, J) = (1.0+CTANH(S*TL) / (ZGEFF*ZO(I, J) ) ) / (l.O+ZGEFF* 

ZO(I,J) *CIANH(S*TL) ) 

ELSEIF(SECIN(I, J) .EQ.2) THEN 
inline resonator 
G(I,J)=1.0+PCAP(I,J) *S/ZGEFF 
ELSEIF(SECIN(I,J) .BQ.3) THEN 

tuned stub , _ ^ 

G ( I , J) =1 • 0+CTANH ( S*SQFT (PIND ( I , J) *PCAP ( I , J) ) ) / ( ZO ( I , J) * 

ZGEFF) 

ELSEIF(SECIN(I,J) .E1Q.4) THEN 

helmholtz resonator 

G(I, J) =1.0+S*PCAP(I, J) / (1.0+PIND(I, J) *PCAP(I, J) *S**2) /ZGEFF 

ELSEIFCSECINCI, J) .EQ.5) THEN 
parallel resonator 
G ( I , J) =PIND ( I , J) *PCAP ( I , J) *S**2+1 . 0 
G ( I , J) =G ( I , J) / (G ( I , J) +PIND ( I , J) *S*ZGEFF) 

ELSEIF(SECIN(I, J) .EQ.6) THEN 
pump 

G(I,J) = (1.0+PCAP(I,J) *S/ZGEFF) / (1.0+(PIND(I, J) *S+ 

AREA ( I , J) ) * (PCAP ( I , J) *S+ZGEFF) ) 

ELSEIF(SECIN(I,J) .EQ.7) THEN 
G(SEGMN(J) , J)=1.0+<3®N(J) *S/ ZGEFF 
ENDIF 

G(I,J)=G(I,J)*ZGEFF 
ZT(I, J) =1. 0/G(I, J) 
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24 CONTINUE 

IF ( SPLIT . NE . 0 . 0 . AND . J . EQ . IP) GO TO 25 
G (SE3GMN ( J) +1 , J) =1 • 0/ ( 1 . O+ZOR ( J) *G ( SEGMN ( J) , J) ) 

G ( SEGMN ( J) +1 , J) =G ( SEGMN ( J) +1 , J) *G (SEOIN ( J) , J) 

25 CONTINUE 

IF (LOPEND.EQ. 1. OR. SPLIT. EQ. 0.0) GO TO 31 
DO 28 J=IP+SPLIT, IP, -1 
IF(J.EQ.IP) IHEN 
IOFHI=SEGMN(J) 

FT.SF 

ZG ( SEGMN ( J) -1 , J) =ZOR ( J) / ( ZOR ( J) *CMftN ( J) *S+1 . 0 ) 
IDFm=SBGMN ( J) -2 
ENDIF 

IF(LOPHI.NE.O) THIN 
DO 27 I=DDPHI,1,-1 
IF(I.EQ.IOFHI.AND.J.EQ.IP) IHEN 
ZG(I, J)=0-0 
ZTEFF=ZT ( 1-1 , J) 

DO 26 K=IP+1 , IP+SPLIT 
ZGEFF=ZG(1,K) 

ZOEFF=ZO ( 1 , K) 

ZLP=L(1,K) 

TL=(L(I,J)+ZLP)/A 

CAPN= ( ZOEFF-ZTEFF) / (ZOEFF+ZTEFF) 

CAPM= ( ZOEFF-ZGEFF) / (ZOEFF+ZGEFF) 

CFAOCEXP (-2 . 0*S*TL) 

RHS= ( ZOEFF+ZGEFF) * ( 1 . 0-CAFN*CAFM*CFAC) *CEXP ( S*ZLP/ A) 
CFACXAFN *CFAC*CEXP ( 2 . 0*S*ZLP/A) 

ZG ( 0 , K) * (RHS-ZOEFF* ( 1 . 0-CFAC) ) / ( 1 . 0+OFAC) 

ZG (I , J) =ZG (I , J) +NOUNE (K) /ZG(0,K) 

26 CONTINUE 
ZG(I,J)=1.0/ZG(I,J) 

ELSE 

ZGEFF=ZG ( 1+1 , J) 

ZOEFF=ZO(I+l,J) 

ZLP=L(I+1,J) 

ZTEFF=ZT(I-1,J) 

IF(SECIN(I+1,J) .LE.l) 'piEN 
C bend in pipe or straight section 

TI>(L(I,J)+ZLP) /A 
CAPN= ( ZOEFF-ZTEFF) / (ZOEFF+ZTEFF) 

CAFM=( ZOEFF-ZGEFF) / (ZOEFF+ZGEFF) 

CFAOCEXP (-2 . 0*S*TL) 

RHS= ( ZOEFF+ZGEFF) * ( 1 . 0-CAPN*CAFM*CFAC) *CEXP ( S* ZLP/A) 
CFAC=CAPN*CFAC*CEXP ( 2 . 0*S*ZLP/A) 

ZG(I,J)= (RHS-ZOEFF* ( 1 . 0-CFAC) ) / ( 1 . O+CFAC) 
ELSEIF(SECIN(I+1, J) .EQ.2) IHEN 
C inline resonator 

ZG(I,J)=ZGEFF/ (ZGEFF*PCAP(I+1,J) *S+1.0) 
ELSEIF(SECIN(I+1,J) .E3Q.3) IHEN 
C tuned stub 

ZG(I, J) =ZOEFF/CIANH(S*SQRT(PIND(I+l / J) *PCAP(I+1, J) ) ) 
ZG(I, J) = (ZG(I, J) *ZGEFF) / (ZG(I, J)+ZGEFF) 
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* 


27 

28 


ELSEIF(SECIN(I+1,J) .EQ.4) THEN 

helrholtz resonator T \*c\ 

ZG ( I , J) = ( 1 • O+PIND ( 1+1 , J) *PCAP(I+1, J) *S**2) / (PCAP(I+1, J) *S) 
ZG ( I , J) = ( ZG ( I , J) *ZGEFF) / ( ZG (I , J) +ZGEFF) 

ELSEIF(SECrN(I+l, J) .EQ.5) THEN 

ZG^"jj’izGETF?pSD < (I+l, J) *S/ (PIND(I+1, J) *PCAP(I+1, J) *S**2+ 

1 . 0 ) 

ELSEIF(SECIN(I+1,J) .BQ.6) THEN 


pump 

ZG ( I , J) =ZGEFF+PIND (1+1, J) *S-AREA ( 1+1 , J) 
ZG(I, J) =ZG(I, J) / (1.0+ZG(I,J) *PCAP(I+1, J) *S) 
ENDIF 
ENDIF 
CONTINUE 
ENDIF 
CONTINUE 


ERRP=0.0 

DO 30 J=IP , IP+SPLIT 
DO 29 1=1 , SEGMN ( J) 

O)IF=CABS(G0ID(I,J)) , , x ,^ TT , 

IF(GDIF.NE.O.O) ODIF=ABS (GDIF-CABS (G (I , J) ) ) /C33IF 

IF (GDIF . GT . ERRP) THEN 

errp=gdif 

W3=CABS(G(I, J) ) 

WGOUXABS (GOID ( I , J) ) 

IWG=I 


JWG=J 

ENDIF 

GOID(I,J)=G(I,J) 

29 CONTINUE 

30 CONTINUE _ 

IF (KLOOP. GT. 1. AND.ERRP.LT. 0.001) GO TO 32 


31 CONTINUE 

IF(LOPEND.EQ.l) GO TO 32 
IF(IOPEN.EQ.O) THEN 
OPEN (UNTT=13 , FILE= ' SURF . ERR ' ) 


* 

* 

* 


WRITE(13,*)' ' 

WRITER,*)' ' 

WRITE (13,*) TITLE 
WRITE(13,*)' ' 

IOPEN=l 

ENDIF 

WRITE(13, ' ( ' ' jw =",F8.1," after' 1 ,13, ' ' iterations'', 

" has error of",F8.3,"% ",A)') 

AIMAG(S) /SFAC,IDPEND,100.0*ERPP,TYPEL(ITLIN) 

WRITE (13 , ' (10X, " I=" , I3,3X, ' 'J=",I3,3X, " |G|=' ' ,1PE12.4,3X, 
• ' I GOLD I = " , E12 .4) ' ) IWG, JWG,WG,WGOLD 


32 CONTINUE 

DO 35 J=IP, IP+SPLIT 
IF(IENG(J) .EQ.0.0) THEN 
RATFT4=0.0 

DO 33 I=IP+1 , IP+SPLIT 




c 


c 


c 

c 


RATEW=RATPM+EWRAT ( IENG (I) ) 

33 CONTINUE 
LOPHI=SEGMN ( J) 

ELSE 

RATFM=EWRAT(IENG(J) ) 

LOPHI=SBGMN ( J) +1 
ENDIF 

DO 34 1=0 , LOPHI 
G(I, J)=PAIFM*G(I, J) 

34 CONTINUE 

IF(J.EQ. IP. AND. SPLIT. NE. 0.0) GO TO 35 
GAEM ( ILINE) =G (LOPHI , J) 

TT.TN E= TT JN E+1 


35 CONTINUE 
REIURN 
END 

SUBROUTINE BENDS (PIPE1 , PIPE2 , PIPED , PIPE4 , VAUJE , DIME) 
Computes effective straight pipe for bend 
REAL LBEND 

LBEND=0 . 0174533*PIPE1*ABS (PIPE2) 

RATIO= (PIPE1-0 . 5*PIPE3 ) / (PIPEl+0 . 5*PIPE3 ) 

CALL GINERT ( ABS (PIPE2 ) , RATIO, Y) 

GAMMA= (LBEND+Y*PIPE3 ) /LBEND 
VALUE=GAMMA* (LBEND+2 . 0*PIPE4 ) 

DIME=PIPE3 / (GAMMA) **0 . 25 


RETURN 

END 

SUBROUTINE BNSECT (J, ITYPE , POINT, PIPE1 , PIPE2 , PIPE3 , PEPE4 ) 
Co m putes plot coordinates for a bend 

COMMON /PIPPXY/X,XH,XL, Y,YH, YL,XMIN,XMAX,YMIN, YMAX,SINA,COSA 

COMMON /ARCOON/XC,YC, RAD, ANG, ANGLE 
REAL POINT (8, 200) 

INTEGER* 2 ITYPE(200) 


first straight section of bend 
IF(PIPE4.NE.0.0) CALL STSECT ( J, ITYPE, POINT, PIPE4 , PIPED ) 
curved section of bend 


IF(PIPE2.GE.0.0) THEN 
XC=X-SINA*PIPE1 


YC=Y+C0SA*PIPE1 


DIA= 0.5 


ELSE 

XC=X+SINA*PIPE1 
YC=Y-C0SA*PIPE1 
DIA=-0 . 5 


ENDIF 


J=U+1 

ITYPE (J)=0 

POINT ( 1 , J) =XC 

POINT (2 ,J) =YC 

POINT ( 3 , J) =ANG 

ANG=ANG+0 . 01745329*PIPE2 

ANGLE=ANGLE+0 . 5*PIPE2 

RANG=0.01745329*ANGLE 
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OOSA=COS (RANG) 

SINA=SIN (RANG) 

FAD=PIPE1-DIA*PIPE3 

POINT (4 , J) =ANG 

POINT ( 5 , J) =RAD 

XO=XC-RAD 

YO=YC+RAD 

X1=XC+RAD 

Y1=YC-RAD 

X2=XH 

Y2=YH 

SLENIH=2 . 0*RAD*SIN (0 . 00872665*ABS (PIPE2) ) 

XH=X2 +OOSA* SLENIH 

YH=Y2+SINA*SLENTH 

X3=XH 

Y3=YH 

IF(DIA.LT.O.O) THEN 
H0ID=X2 
X2=X3 
X3=H0LD 
H0ID=Y2 
Y2=Y3 
Y3=H0ID 
ENDIF 

RAD=PIPE1+DIA*PIPE3 

XO=XC-RAD 

YO=YC+RAD 

X1=XC+RAD 

Y1=YC-RAD 

X2=XL 

Y2=YL 

SLENIH=2 . 0*RAD*SIN (0 . 00872665*ABS(PIPE2) ) 

XL=X2-KX)SA*SLENIH 

YL=Y2+SINA*SLENIH 

X3=XL 

Y3=YL 

IF(DIA.LT.O.O) THEN 
H0ID=X2 
X2=X3 
X3=H0ID 
H0LD=Y2 
Y2=Y3 
Y3=H0LD 
ENDIF 
3 = 3+1 
ITYPE(J) =0 

POINT ( 1 , J) =P0INT ( 1 , J-l) 

POINT (2 , J) =POINT ( 2 , J-l) 

POINT ( 3 , J) =POINT ( 3 , J-l) 

POINT ( 4 , J) =POINT ( 4 , J-l ) 

POINT ( 5 , J) =RAD 

SLENIH=2 . 0*PIPE1*SIN (0 . 00872665*ABS (PIPE2) ) 
X=X+OOSA*SLENTH 
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Y=Y+SINA*SLENrH 
XMIN=AMIN1 (X, XL, XH, XMIN) 

XMAX=AMAX1 ( X , XL , XH , XMAX) 
YMIN=AMIN1(Y,YL,YH,YMIN) 
YMAX=AMAX1(Y,YL,YH,YMAX) 

C last straight section of bend 

ANGLB=ANGLE+0 . 5*PIPE2 
RANG=0.01745329*ANGLE 
OOSA=OOS(RANG) 

SINA=SIN (RANG) 

J=G+1 

ITYPE(J) =1 

POINT(l f J)=XH 

P0INT(2 , J)=YH 

POINT (3 ,J) =XL 

POINT (4 ,J) =YL 

X=X+OOSA*PIPE4 

XB=X-0 . 5 *SINA*PIPE3 

XLfX+O . 5*SINA*PIPE3 

Y=Y+SINA*PIPE4 

YH=Y+0 . 5*COSA*PIPE3 

YD=Y-0 . 5*OOSA*PIPE3 

POINT(5,J)=XH 

POINT (6 , J) =YH 

POINT(7,J)=XL 

POINT(8,J)=YL 

XMIN=AMIN1(X,XL,XH,XMIN) 

XMAX=AMAX1(X,XL,XH,XMAX) 

YMIN=AMIN1 ( Y, YL, YH , YMIN) 
YMAX=AMAX1(Y,YL,YH,YMAX) 

REIURN 

END 

COMPLEX FUNCTION CCOSH(S) 

C Evaluates the complex hyperbolic cosine 

COMPLEX S 
REAL LAMDA, MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 

OOSHR=COSH (LAMDA) *COS (MU) 

COSHI=SINH (LAMDA) *SIN (MU) 

COOSB=CMPLX (OOSHR, COSHI) 

RETURN 

END 

OCMPLEX FUNCTION CSINH(S) 

C Evaluates the conplex hyperbolic sine 

OCMPLEX S 
REAL IAMDA, MU 
LAMD A=REAL ( S ) 

MU=AIMAG(S) 

SINHR=SINH (LAMDA) *COS (MU) 

SINHI=OOSH (IAMDA) *SIN (MU) 
CSINH=<MPLX(SINHR, SINHI) 

RETURN 
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END 

COMPLEX FUNCTION CTANH(S) 

C Evaluates the complex hyperbolic tangent 

COMPLEX CCOSH,CSINH,S 
CIANH=CSINH(S) /COOSH(S) 

RETURN 

END 

SUBROUTINE ENGNO(IUNIT) 

C Reads engine parameters 

COMMON /EPARAM/MENG,TFD0W(25) ,PCHMB(25) ,DPRDR(25) ,PMRAT(25) 
READ(IUNIT, *)MENG 
IF(MENG.GT.25) THEN 

WritE(*, *) * Number of engines must be less than 25 
STOP 
ENDIF 

IF(MENG.LE.O) MENG=1 
DO 21 I=1,MENG 

READ (IUNIT,*) TFLOW (I) ,PCHMB(I) ,DFROR(I) 

EMRAT ( I ) =PCHMB ( I ) /TFLOW ( I ) 

21 CONTINUE 
RETURN 

END 

SUBROUTINE FUEL(S,GF, IUNIT,IUNlTP,IGONE) 

C Handles fuel piping logic 

COMPLEX GF (25) ,S 

COMMON /EPARAM/MENG, TFLOW (25) ,PCHMB(25) ,DF!ROR(25) ,EMRAT(25) 
INTEGER SEGMN(25) ,SECIN(75, 25) ,NOLINE(25) ,IENG(25) ,ITANK(25) , 

* LOPOLD(25) ,LOPEND(25) 

REAL KMAN(25) ,KTANK(25) ,LFI£W(25) ,L(75,25) 

COMMON /FPARAM/MLINE, SPLIT (25) ,A(25) ,CMAN(25) ,CTANK(25) , 

* DENS(25) ,KMAN,KIANK,LFLCW,VOL(25) ,VOLMF(25) , 

* AREA(75, 25) ,DIA(75,25) ,L,PIND(75,25) , 

* PCAP(75,25) ,AVGK(25), 

* SEGMN,SEXTN,NOIJNE / IENG / ITANK / IiOPOLD,IGPEND 

COMMON /POPIPE/PIPE1 (75 , 25) ,PIPE2 (75,25) , PIPED (75,25) , 

* PIPE4 (75,25) ,PIPE5(75,25) 

CHARACTER* 2 4 FUELIN,NAMLIN(2) 

COMMON /WCAOUT/NAMLIN 
CHARACTER* 1 ANS 
IF(IGONE.EQ. 2) THEN 

WRITE(*, ' (A\) ') ' Is the fuel file name FUEL.RIN? (Y/N) 
READ(*, ' (A) 1 ) ANS 

IF(ANS.NE. 'N' .AND.ANS.NE. 'n') THEN 
OPEN (UNIT=IUNIT,FILE=' FUEL.RIN' ) 

NAMLIN ( 1 ) = ' FUEL . RIN ' 

ELSE 

WRITE(*, ' (A\) ') ' Enter name of file with fuel line data 
READ(*, 1 (A) 1 )FUETJN 
OPEN ( IUNIT , FTLE=FUFT,TN) 

NAMLIN (1)=FUELIN 

ENDIF 

OPEN (IUNITP,FOPM=' UNFORMATTED') 

ENDIF 
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c 


CALL FULOX (S,GF, SEOLN , SECIN , PIPE1 , PIPE2 , PIPE3 , PXPE4 , PIPES , 

* A, AREA, AVGK, OMAN, CIANK, DENS, DIA, IENG,IGONE,ITANK, 

* IUNIT, IUNITP, KMAN,KTANK,L, LOPEND, LOPOLD, LFLOW,MLINE, NOLINE, PCAP, 

* P]ND, SPLIT, VOL, VOIMF, 1) 


RETURN 

END 

SUBROUTINE FULOX (S, GF, SE3GMN, SECIN, PIPE1, PIPE2 , PIPE3 , PIPE4 , PIPE5 , 

* A, AREA, AVGK, OMAN, CIANK, DENS, DIA, IENG,IGONE,ITANK, 

* IUNIT, IUNITP, KMAN,KTANK,L, LOPEND, LOPOLD, LFL£W,MLTNE, NOLINE, PCAP, 

* PIND, SPLIT, VOL, VOIMF, ITLIN) 

Handles read, modify, and admittance calls for fuel and lox 
COMMON /EPARAM/MENG,TFLCW(25) ,PCHMB(25) ,DPRQR(25) ,FMRAT(25) 

INTEGER SE3GMN (25) ,SECIN(75,25) ,NOLINE(25) ,IENG(25) ,ITANK(25) , 


* LOPOLD(25) ,L0PEND(25) 

REAL KMAN(25) ,KTANK(25) ,LFLCW(25) ,L(75,25) 

REAL SPLIT (25) ,A(25) ,CMAN(25) ,CTANK(25) , 

* DENS(25) ,VOL(25) ,VOLMF(25) , 

* AREA(75, 25) ,DIA (75,25) , PIND (75,25) , 

* PCAP(75,25) ,AVGK(25) 

REAL PIPE1 (75,25) ,PIPE2 (75,25) , PIPED (75,25) , 

* PIPE4 (75,25) ,PIPE5 (75,25) 

COMPLEX GF(25) ,S 
CHARACTER*20 TITL 
CHARACTER* 1 ANS 
CHARACTER*40 QUEST1(2) 

CHARACTER*48 QUEST2(2) 

CHARACTER*40 QUEST3(2) 

DATA QUEST1/ 1 Do you wish to modify fuel line data? ' , 

* 1 Do you wish to modify lox line data? 1 / 

DATA QUEST2/ ' Do you wish to modify current fuel line data? 

* * Do you wish to modify current lox line data? 

DATA QUEST3/ ' Do you wish to rewind fuel line file? ' , 

* ' Do you wish to rewind lox line file? '/ 


7 


IF(IGONE.EQ.2) THEN 

CALL RLINE (TITL, SEEMN, SECIN, PIPE1 , PIPE2 , PIPED , 

* PIPE4 , PIPES , L, AREA, DIA, PIND, PCAP, LOPEND, LOPOLD, SPLIT , IUNIT , 

* A, CMAN,CIANK, DENS, KMAN,KTANK,LFLOW, VOL, VOIMF, NOLINE, IENG,ITANK, 

* AVGK,MLINE) 

REWIND IUNITP 

WRITE ( IUNITP) PIPE1 , PIPED , PIPED , PIPE4 , PIPES 
WRITE(*, ' (A\) ' ) QUEST1 (ITLIN) 

READ(*, ' (A) 1 ) ANS 

IF (ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN 

CALL MODIFY (TITL, SEX34N, SECIN, PIPE1, PIPED, PIPED, 

* PIPE4 , PIPES , L, AREA, DIA, PIND, PCAP, LOPEND, LOPOLD , SPLIT , IUNIT , 

* A, CMAN,CTANK, DENS, KMAN,KTANK,LFLOW, VOL, VOIMF, NOLINE, IENG, HANK, 

* AVGK,MLINE) 

REWIND IUNITP 

WRITE ( IUNITP) PIPE1 , PIPED , PIPED , PIPE4 , PIPES 


ENDIF 

ELSEIF(IGONE.EQ.O) THEN 


IP=1 


TT,TNE=1 
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DO 21 I=1,MLINE 
rP=ITANK(I) 

CALL ADMn(S,GF,A(IT) ,AREA,CMAN,CIANK(IT) ,DPROR, 

* L,LFLCW(IT) ,FMRAT,SE)GMN, SECIN, 

* SPLIT (I) ,LOPEND(I) ,PCAP, PIND, IENG,TFLCW, 

* NOLINE, IP, ILINE,ITLIN) 

IP=IP+SPLIT(I)+1 

21 CONTINUE 
RETURN 

ELSEIF(IGONE .EQ. 1) THEN 
WRITE^*, ' (A\) 1 ) QUEST2 (ITLIN) 

READ(*, ' (A) 1 ) ANS 

IF(ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN 
CALL MODIFY (TTTL, SEGMN , SECIN , PXPEl , PIPE2 , PXPE3 , 

* PIPE4, PIPES, L, AREA, DIA,PIND,PCAP,I£)PEND,IOPOLD, SPLIT, IUNIT, 

* A, CMAN,CIANK, DENS, KMAN,KIANK,LEI/OW, VOL, VOIMF, NOLINE, IENG,ITANK, 

* AVGK,MLINE) 

REWIND IUNITP 

WRITE (IUNITP) PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPES 
ELSE 

WRITER, ' (A\) ')QUEST3 (ITLIN) 

READ(*, ' (A) ' )ANS 

IF(ANS .EQ. 'Y' .OR. ANS .EQ. 'y') REWIND IUNIT 
CALL RUNE (TTIL,SEGMN, SECIN, PIPE1,PIPE2 / PIPE3, 

* PIPE4, PIPES, L, AREA, DIA,PIND,PCAP,LOPEND,LOPOLD, SPLIT, IUNIT, 

* A,CMAN,CTANK,DENS,KMAN,KrANK,LFLOW,VOL,VOLMF,NOLINE,IENG,ITANK, 

* AVGK,MLINE) 

REWIND IUNITP 

WRITE (IUNITP) PIPE1 , PIPE2 , PLPE3 , PIPE4 , PIPES 
WRITE (*,*) QUEST1 ( ITUN) 

WRITE(*, ' (A\) ') ' if not, press enter key. ' 

READ(*, ' (A) ' ) ANS 
WRITE(*,*)' ' 

IF (ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THIN 
CALL MODIFY (TTTL , SEGMN , SECIN , PIPE1 , PIPE2 , PIPE3 , 

* PIPE4 , PIPES , L, AREA, DIA, PIND, PCAP, LOPEND, LOPOLD, SPUT , IUNIT , 

* A, CHAN, CTANK, DENS, KMAN,KTANK,LF1£W, VOL, VOLMF, NOLINE, IENG, ITANK, 

* AVGK,MLINE) 

REWIND IUNITP 

WRITE (IUNITP) PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPES 
ENDIF 
ENDIF 
IGONE=0 
ENDIF 
RETURN 
END 

SUBROUTINE GETKS(N,K,I, J,K1R,K2R,K3R,K4R,K1C,K2C,K3C,K4C) 

C Determines Nyquist equation to be plotted 

REAL KlR(lOOl) ,K1C(1001) ,K2R(1001) ,K2C(1001) ,K3R(1001) ,K3C(1001) , 

* K4R(1001) ,K4C(1001) 

REAL R1K(25) ,C1K(25) ,R2K(25) ,C2K(25) ,R3K(25) ,C3K(25) , 

* R4K(25) ,C4K(25) 

REWIND 17 
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c 


c 


M=0 

IF(I.NE.O.AND.J.NE.O) THEN 
CALL GEIM(I/ J ,M) 

IF (M.EQ.O) THEN 
K=0 


RETURN 

ENDIF 

ENDIF 

DO 21 Lf=l,N 

READ ( 17 ) R1K , C1K , R2K , C2K , R3K , C3K , R4K, C4K 
K1R(L)=R1K(K) 

K1C(L) =C1K(K) 

IF(J.NE.O) THEN 
K2R(L) =R2K(J) 

K2C(L) =C2K(J) 

ENDIF 

IF(I.NE.O) THEN 
K3R(L)=R3K(I) 

K3C(L)=C3K(I) 

ENDIF 

IF (M.NE.O) THEN 
K4R (L) =R4K (M) 

K4C (L) =C4K (M) 

ENDIF 

21 OONTINUE 
RETURN 
END 

SUBROUTINE GETM(I,J,M) 

Determines location of data to be plotted 
INTEGER SEGMN,SECIN(150) 

COMMON / SETUP/ PIPE1 ( 150) ,PIPE2(150) ,PIPE3(150) ,PIPE4(150) , 

* NENGF(25) ,NTANKF(25) ,NUNEF(25) ,NSPF(25) ,ILENEF, 

* NENGO(25) ,NIANKO(25) ,NEJNEO(25) ,NSPO(25) ,ILINEO / 

* SEGMN,SECIN 
DO 22 11=1, ILINEF 

DO 21 JJ=1 , ITjINEO 

IF(NENGF(II) .NE.NENGO(JJ) ) GO TO 21 
M^I+1 

IF(II.E)Q. I.AND. JJ.E3Q. J) RETURN 


21 CONTINUE 

22 CONTINUE . 

WRITE(*,*) ' Somethings WRONG! Plot will be bypassed. 

M=0 

RETURN 

END 

SUBROUTINE GINERT(BEND,X, Y) 

Evaluates curve fit of inertance of bends 


DIMENSION B(3) 

DATA B/0. 0, 0. 7877014E-02 , -0 . 2814679E-04/ 

A=B (1) + (B (2 ) +B ( 3 ) *BEND) *BEND 

Y=A* (X-l . 0) **2 

RETURN 

END 
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SUBROUTINE HHSECT(J, ITYPE, POINT, LEN,DIA, VOL) 

C Computes plot coordinates for Helmholtz resonator 

COMMON /PIPPXY/X,XH,XL, Y, YH, YL,XMIN,XMAX,YMIN,YMAX,SINA,OOSA 

REAL LEN, POINT (8, 200) 

INTEGER* 2 ITYPE(200) 

xou>=x 

XHOLD=XH 

XLOID=XL 

YOII>=Y 

YH0LD=YH 

YLOID=YL 

SINOID=SINA 

OOSOUXOSA 

DIAM=SQRT( (XH-XL) **2+(YH-YL) **2) 

CALL TSSECr(J,ITYPE / POINT, LEN, DIA) 

XC=0 . 5* (XOID+X) 

YG=0 . 5* ( YOID+Y) 

XOID=X 

YOU>Y 

SINA=OOSOLD 

COSA=-SINOLD 

X=XC+OOSA* (LEN+0 . 5*DIAM) 

Y=YC+SINA* (LEN+O . 5*DIAM) 

SIDE=VOL**0. 3333333 

CALL STSECT ( J , ITYPE , POINT , SIDE , SIDE) 

X=XOID 

Y=YOLD 

SINA=SINOLD 

COSA=COSOLD 

DIAM=SQRT( (XHOLD-XLOLD) **2+(YH0LD-YL0ID) **2) 

XH=X-0 . 5*SINA*DIAM 
XL=X+0 . 5*SINA*DIAM 
YH=Y+0 . 5*C0SA*DIAM 
YL=Y-0 . 5*OOSA*DIAM 
RETURN 

END 

SUBROUTINE DOX(S,GOX,IUNIT,IUNITP,IGC»JE) 

C Handles fuel piping logic 

COMPLEX GOX(25) ,S 

COMMON /EPARAM/MENG,TFL0W(25) ,PCHMB(25) ,DPROR(25) ,EWRAT(25) 
INTEGER SEGMN(25) ,SECIN(75,25) ,NOLINE(25) ,IENG(25) ,ITANK(25) , 

* LOPOLD(25) , LOPEND(25) 

REAL KMAN(25) ,KTANK(25) ,LFLCW(25) ,L(75,25) 

COMMON /OPARAM/MLINE, SPLIT(25) ,A(25) ,CMAN(25) ,CTANK(25) , 

* DENS(25) ,KMAN,KTANK,LFLCW,VOL(25) ,VOIMF(25) , 

* AREA(75, 25) ,DIA(75,25) ,L,PIND(75,25) , 

* PCAP(75,25) ,AVGK(25) , 

* SBGMN, SECIN, NOLINE, IENG, ITANK, LOPOLD, IOPEND 
COMMON /EOPIPE/PIPE1 (75,25) ,PIPE2(75,25) ,PIPE3 (75, 25) , 

* PIPE4 (75,25) ,PIPE5(75,25) 

CHARACTER* 2 4 LOXIN,NAMLIN(2) 

COMMON /WCAOUT/NAMLIN 
CHARACTER*! ANS 
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c 


IF(IGONE.EQ. 2) THEN 

WRITE(*, ' (A\) ') 1 Is the lox file name LDX.RLN? (Y/N) ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'N' .AND.ANS.NE. 'n') THEN 
OPEN (UNIT=IUNIT , FILE= ' LOX . RIN ' ) 

NAMLIN ( 2 ) = 1 LOX . RLN ' 

ELSE 

WRITE (*, ' (A\) ') 1 Enter name of file with lox line data 1 
READ(*, ' (A) 1 ) LDXIN 
OPEN (IUNIT, FTLE=IOXIN) 

NAMLIN ( 2 ) =LOXIN 

ENDIF 

OPEN ( IUNITP , FORM= ' UNFORMATTED ' ) 

ENDIF 

CALL FUIOX (S, GOX, SE3GMN , SECIN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPES , 

* A,AREA,AVGK,CMAN,CrANK,DENS,DIA, IENG,IGONE, ITANK, 

* IUNIT, IUNITP, KMAN,KTANK,L,LOPEND,LOPOID,LFLCW,MLINE, NOLINE, PCAP, 

* PIND,SPLrr,VOL,VOLMF,2) 


RETURN 

END 

SUBROUTINE MODCON (IUNIT, VARI,MENG, TAUT, CSTAR, RBAR, THETAC, DCDR) 
Modifies CONST. RIN parameters 
REAL TAUT (25) ,CSTAR(25) ,RBAR(25) ,THEEAC(25) ,DCDR(25) 

CHARACTER* 2 4 VARI 
CHARACTER* 8 NAME 
CHARACTER* 1 ANS 
CHARACTER* 8 VARL(5) ,VARU(5) 

DATA VARL/ 'taut ' , 'cstar ' , 'rbar ' , 'thetac ' , 'dcdr ' / 
DATA VARU/ 'TAUT ' , 'CSTAR ','RBAR 'THETAC ','DCDR '/ 

DO 25 J=1,MENG 

WRITE(*, ' (A,I3,A\) ') ' Do you wish to change parameters for engine 

* <V? ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.NE. ' Y ' .AND.ANS.NE. 'y ' ) GO TO 25 


21 CONTINUE 

WRITER,*)' ' 

WRITE (*,*) ' VARIABLE NAMES AND VALUES' 

WRITER,*)' ' 

WRITE(*, ' (A, 1PE15.5) ') ' TAUT - transport lag 

* TAUT(J) 

WRITE(*, ' (A, 1PE15.5) ') ' CSTAR - characteristic rocket velocity 

* CSTAR (J) 

WRITE(*, ' (A, 1PE15. 5) ') ' RBAR - mixture ratio 

* RBAR(J) 

WRTTE(*, ' (A, 1PE15. 5) ') ' THETAC - characteristic time constant 

* THETAC (J) 

WRITE(*, ' (A, 1PE15.5) ') ' DCDR - d (velocity) /d (mixture ratio) 

* DCDR(J) 

WRITE(*,*) ' ' 

WRITE (*, *) ' Enter variable name and new value, or' 

WRTTE(*,*) ' # to print variable names & values, or' 

WRITE (*,*) ' END when all changes have been made' 

WRITE(*,*) ' ' 
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22 CONTINUE 

WRITE (*, ' (A\) ' ) 1 Enter variable name and new value, END, or 
CALL ZREAD (NAME, VALUE) 

IF (NAME. EQ. '#' ) GO TO 21 

IF(NAME.EQ. 'END' .OR.NAME.EQ. 'end') GO TO 25 
DO 23 11=1,5 
I=II 

IF(NAME.E)Q.VARU(I) .OR.NAME.EQ. VARL(I)) GO TO 24 

23 CONTINUE 

WRITER,*)' Invalid name, try again' 

GO TO 21 


1) 

2 ) 

3) 

4) 

5) 


TAUT ( J) =VALUE 
CSTAR(J)=VALUE 
REAR(J)=VALUE 
THETAC ( J) =VALUE 
DCDR(J)=VALUE 


24 CONTINUE 
IF(I.EQ. 

IF(I.BQ. 

IF(I.EQ. 

IF(I.EQ. 

IF(I.EQ. 

GO TO 22 

25 CONTINUE 

WRITE (*, ' (A\) * ) 1 Do you wish to save these changes. Y or N 
READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y') RETURN 

WRITE(*, ' (A,A,A\) ') ' Do you wish to use file ' ,VARI, 

* •? Y or N ' 


# 


i 


READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y') THEN 
WRITE(*, ' (A\) ') ' Enter name of file to use ' 
READ(*, ' (A) ' ) VARI 
CLOSE (UNIT=IUNIT) 

OPEN (UNIT=IUNIT , FILE=VARI ) 

ELSE 

WRITE(*, ' (A,A,A\) ') ' Do you wish to rewind ' ,VARI, 
* •? Y or N ' 


READ(*, ' (A) ')ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. ' y * ) REWIND IUNIT 
ENDIF 

DO 26 J=1,MENG , v 

WRITE (IUNIT, ' (1P5E15.5) ')TAUT(J) ,CSIAR(J) ,RBAR(J) , , IHEIAC(J) , 

* DCDR(J) 

26 OONITNUE 
REIUFN 
END 

SUBROUTINE MODENG( IUNIT, NAMENG) 

C Modifies engine parameters 

COMMON /EPARAM/MENG,TF10W(25) ,PCHMB(25) ,DFROR(25) ,FMRAT(25) 

CHARACTER*24 NAMENG 

CHARACTER*8 NAME 

CHARACTER* 1 ANS 

CHARACTER* 8 VARL(3) ,VARU(3) 

DATA VARL/'tf low ','pchmb ' , '<%>ror V 

DATA VARU/'TFLOW ','PCHMB ','DPRDR '/ 

DO 25 J=1,MENG , . 

WRiTE(*, ' (A,A,I3,A\) ') ' Do you wish to change flow conditions , 
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* 'for engine ' 

READ(*, ' (A) ')ANS 

IF(ANS.NE. » Y ' .AND.ANS.NE. 'y ' ) GO TO 25 
21 CONTINUE 

WKETEC*,*)' ' 

WRITE(*,*) 1 VARIABLE NAMES AND VALUES' 

WRITE^*,*) 1 1 

WRITE (*, ' (A, 1PE15.5) ') ' TFIOW - total mass flew (lbm/sec) \ 

* TFLCW (J) 

WRITE(*, ' (A, 1PE15. 5) ') ' PCHMB - chamber pressure (lbf/ft 2) , 

* PCHMB (J) 

WRTTE(*, ' (A, 1PE15.5) ’) ' DEROR - orfice pressure drop (lbf/ft 2) ' , 

* DPROR(J) 


WRITER,*)' ' 

WRITE (*,*) ' Enter variable name and new value, or 

' # to print variable names & values, or' 

VjrtTE(*[*) ' EUD when all changes have been made' 

WRITE(*,*) ' ' 

22 CONTINUE 

Write (*, ' (A\) ') ' Enter variable name and new value, END, or 
CALL ZREAD (NAME, VALUE) 

IF(NAME.EQ. '#') GO TO 21 

IF(NAME.E)Q. 'END' .OR.NAME.EQ. 'end') GO TO 25 
DO 23 11=1,3 
I=II 

IF(NAME.EQ.VARU(I) . OR.NAME.EQ. VAHL(I) ) GO TO 24 

23 CONTINUE 

WRITE(*, *) ' Invalid name, try again' 

GO TO 21 

24 CONTINUE 

IF(I.EQ. 1) TFLOW(J)=VALUE 
IF(I.EQ. 2) PCHMB (J)=VAIXJE 
IF(I.BQ. 3) DPROR ( J) =VAUJE 
EWRAT ( J) =PCHMB ( J) /TFIOW ( J) 

GO TO 22 

25 CONTINUE ^ „ . 

WRITE(*, ' (A\) ') ' Do you wish to save these changes. Y or N 

READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y') REIURN 

WRITE(*, ' (A,A,A\) ') ' Do you wish to use file ' ,NAMENG, 

★ '? Y or N ' 


# 


I 


READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y') THEN 
WRITE(*, ' (A\) ') ' Enter name of file to use 1 
READ(*, ' (A) ' )NAMENG 
CLOSE (UNIT=IUNIT) 

OPEN (UNIT=IUNIT, FH£=NAMENG) 

ELSE 

WRITE(*, ' (A,A,A\) ') ' Do you wish to rewind ' ,NAMENG, 
* '? Y or N 1 


READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. 'Y'.OR.ANS.EQ. 'y') REWIND IUNIT 
ENDIF 
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WRITE (IUNIT, ' (15) ')MENG 
DO 26 J=1,MENG 

WRITE(IUNIT, ' (1P3E15.5) ')TFLOW(J) ,PCHMB(J) ,DPROR(J) 

26 CONTINUE 
RETURN 
EM) 

SUBROUTINE MODIFY (TTTL, SBGMN, SECIN , PIPE1, PIPE2 , PIPE3 , 

* PIPE4,Pn ) E5,L, AREA, DIA ; PIND / PCAP / I£)PEND,IOPOI£), SPLIT, IUNIT, 

* A, CMAN,CTANK, DENS, KMAN,KIANK,LFIOW, VOL, VOLMF, NOLINE, IFNG,ITANK, 

* AVGK,MLINE) 

C Allows modifications to input data 

CCMMON /EPARAM/MENG,TFUDW(25) ,PCHMB(25) ,DP!ROR(25) ,PMRAT(25) 

COMMON /TANK/MTANK 
CHARACTER* 2 4 NAMLIN(2) 

COMMON / WCAOUT / NAMLIN 
REAL SPLIT(25) ,AVGK(25) 

REAL AREA(75, 25) ,DIA(75,25) ,L(75,25) ,PIND(75,25) , 

* PCAP(75,25) 

REAL PIPE1(75,25) ,PIPE2 (75,25) ,PIPE3 (75,25) ,PIPE4 (75, 25) , 

* PIPE5 (75,25) 

INTEGER SEGMN(25) ,SECIN(75,25) 

INIEGER ITANK(25) ,IENG(25) ,LOPOLD(25) ,LOPIND(25) ,NOLINE(25) 

REAL A(25) ,CTANK(25) ,DENS(25) ,KTANK(25) ,CMAN(25) ,KMAN(25) , 

* LFU3W(25) ,VOL(25) ,VOIMF(25) 

CHARACTER*20 TTTL 
CHARACTER* 1 ANS 

1 FORMAT ( 1PE15 . 6) 

2 FORMAT (15, 1P5E15.6) 

3 FORMAT ( 1 This segment is a bend of ' ,1PE13.5, 1 deg and radius of , 

* E13.5) 

4 FORMAT ( ' This segment is straight 1 ,1PE13.5, ' diameter pipe , 

* E13.5,' ft. long') 

5 FORMAT ( ' This segment is a manifold with' ,1PE13.5, ' vol.', 

* E13.5,' bulk modulus') t _ 

6 FORMAT (' This segment is a pump with length =' , 1PE13 . 5, ' dia =', 

* E13.5/5X, *dp/dm =',E13.5, ' capacitance =', E13 . 5 , 

* ' inductance =' ,E13.5) _ , _ 

7 FORMAT ( ' This segment is a tuned pipe ' , 1PE13 . 5 , ' long & dia =', 

* E13.5) 

8 FORMAT (' This segment is a Helmholtz resonator with' /5X, 'length - 

* , 1PE13 . 5 , ' dia = ' , E13 . 5 , ' and vol =' ,E13.5) 

9 FORMAT (' This segment is a parallel resonator with '/5X, 'length -' 

* 1PE13.5,' dia = ' , E13 . 5 , ' and vol =' ,E13.5) 

10 FORMAT ( ' This segment is a',lPE13.5,' long inline a cc. with', 

* ' diameter of ' , E13 . 5) 

IF (IUNTT.EQ.il) THEN 

NAMNAM=1 

ELSE 

NAMNAM=2 

ENDIF 

WRITE(*, ' (A\) ') ' Do you wish to change tank parameters? 

READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. 'y') THEN 
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CALL MODTAN (MIANK,VOL,LFLCW,KI!ANK,DENS,A,CI!ANK) 
eroiF 

WRITE (*, ' (A\) ') ' Do you wish to change the pipe layout. 

READ(*, ' (A) ' ) ANS 

IF(ANS.NE. * Y ' .AND.ANS.NE. 'y') GO TO 28 
IP=0 

DO 27 M=1,MLINE 
IP=IP+1 
ir=ITANK(M) 

DO 26 IPP=IP , IP+SPLIT (M) 

1=0 

ISEGMN=SBGMN ( IPP) 

DO 25 11=1, SEGMN( IPP) 

1=1+1 

IF(SECIN(I,IPP) .BQ.O) THEN 
WRITE(*,3)PIPE2(I,IPP) ,PIPE1(I,IPP) 

ELSEIF(SECIN(I,IPP) .EQ.l) THEN 
WRITE(*,4)PIPE2 (I, IPP) ,PIPE1(I,IPP) 

ELSEIF(SECIN(I, IPP) .EQ.2) THEN 
WRITE(*,10)PIPE1(I,IPP) ,PIPE2(I,IPP) 

ELSEIF(SECIN(I,IPP) .EQ.3) THEN 
WRITE(*,7)PIPE1(I,IPP) , PIPE2 (I, IPP) 

ELSEIF(SECIN(I,IPP) .EQ.4) THEN 
WRITE(*,8)PIPE1(I,IPP) ,PIPE2(I / IPP) ,PIPE3 (I, IPP) 
ELSEIF(SECIN(I / IPP) .EQ.5) THEN 
WRITE(*,9)PIPE1(I,IPP) ,PIPE2(I,IPP) ,PIPE3(I,IPP) 
ELSEIF(SECIN(I,IPP) .EQ.6) THEN 
WRITE(*,6)PIPE1(I,IPP) , PIPE2(I,IPP) ,PIPE3 (I, IPP) , 

* PrPE4(I,IPP) ,PIPE5(I,IPP) 

ELSEIF(SECIN(I,IPP) .EQ.7) THEN 

WRITE(*,5)PIPE1(I,IPP) ,PIPE2 (I, IPP) 

ENDIF , , 

WRITE(*, ' (A\) ') ' You may keep (K) , modify (Y) , delete (D) , , 

* • add before (B) , or add after (A)? ' 

READ(*, ' (A) ')ANS 

IF(ANS.EQ. 'A' .OR.ANS.EQ. 'a') THEN 
1=1+1 

DO 21 III=ISEGMN, I , -1 
PIPE1 (III+l , IPP) =PIPE1 (III , IPP) 

PIPE2 (III+l , IPP) =PIPE2 (III , IPP) 

PIPE3 (III+l, IPP) =PIPE3 (III, IPP) 

PIPE4 (III+l, IPP) =PIPE4 (III, IPP) 

PIPES ( III+l , IPP) =PIPE5 ( III , IPP) 

L(III+1 , IPP) =L(III , IPP) 

DIA(III+1 , IPP) =DIA(III , IPP) 

AREA ( III+l , IPP) =AREA ( III , IPP) 

PCAP ( III+l , IPP) =PCAP (III , IPP) 

PIND ( III+l , IPP) =PIND ( III , IPP) 

SECIN ( III+l , IPP) =SECIN (III , IPP) 

21 CONTINUE 

ISEGMN=ISEGMN+1 
GO TO 24 

ELSEIF(ANS.EQ. 'B' .OR.ANS.EQ. 'b') THEN 
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22 


23 



DO 22 III=ISEGMN, I , -1 
PIPE1 (III+l, IPP) =PIPE1 (III , IPP) 

PIPE2 (III+l, IPP) =PIPE2 (III, IPP) 

PIPE3 (III+l, IPP) =PIPE3 (III, IPP) 

PIPE4 (III+l, IPP) =PIPE4 (III, IPP) 

PIPES ( III+l , IPP) =PIPE5 ( III , IPP) 

L ( III+l , IPP) =L ( III , IPP) 

DIA ( III+l , IPP) =DIA ( III , IPP) 

AREA (III+l, IPP) =AREA( III, IPP) 

PCAP ( III+l , IPP) =PCAP ( III , IPP) 

PIND ( III+l , IPP) =PIND (III , IPP) 

SECIN (III+l, IPP) =SECIN (III, IPP) 

CONTINUE 
ISEXMN=ISEGNN+1 
GO TO 24 

ELSEIF(ANS.EQ. 'D' .OR.ANS.EQ. 'd' ) THEN 
DO 23 III=I , ISEGMN 
PIPE1 (III , IPP) =PIPE1 (III+l , IPP) 

PIPE2 (III , IPP) =PIPE2 (III+l, IPP) 

PIPES (III , IPP) =PIPE3 (III+l, IPP) 

PIPE4 (III , IPP) =PIPE4 (III+l, IPP) 

PIPES (III , IPP) =PIPE5 (III+l, IPP) 

L (III , IPP) =L ( III+l , IPP) 

DIA ( III , IPP) =DIA (III+l , IPP) 

AREA ( III , IPP) =AREA (III+l , IPP) 

PCAP (III , IPP) =PCAP (III+l , IPP) 

PIND ( III , IPP) =PIND ( III+l , IPP) 

SECIN ( III , IPP) =SECIN (III+l , IPP) 

CONTINUE 

1=1-1 

ISE)GMN=ISEGMN-1 
GO TO 25 

EXSEIF (ANS.NE. ' Y ' .AND.ANS.NE. 'y') THEN 
GO TO 25 
ENDIF 
CONTINUE 

WRITE(*,*) 1 Specify 0 for BEND, 1 for STRAIGHT pipe, ' 

WRITE (*,*) 1 2 for INLINE AOCUM. , 3 for TUNED STUB, ' 

WRITE(*,*) ' 4 for HELMHOLTZ RES., 5 for PARALLEL RES. * 

WRITE(*,*) ' 6 for PUMP, 7 for MANIFOLD' 

READ(*, *) SECT 

IF(SECT.LT.O.OR.SECr.GT.7) GO TO 24 
SECTN ( I , IPP) =SECT 
IF(SECT.EQ.O) THEN 
bend in pipe 

WRITE(*,*) ' RADIUS of bend along CL(ft) , ANGLE of bend (deg) , ' 
WRITE(*,*) ' DIAMETER (ft) , and LENGTH(ft) beyond bend of pipe' 
RIAD(*, *) PIPE1 (I, IPP) , PIPES (I, IPP) , PIPES (I, IPP) ,PIPE4 (I, IPP) 
CALL RTYPE (SECIN (I, IPP) ,PIPE1(I,IPP) , PIPES (I, IPP) , 

PIPES (I, IPP) , PIPE4 (I, IPP) , PIPES (I, IPP) ,L(I,IPP) , 
AREA(I,IPP) , DIA (I, IPP) ,PIND(I, IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) , OMAN (IPP) ,KMAN(IPP) ,VOIMF(IPP) ) 
ELSEIF(SECr.EQ.l) THEN 
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straight section 

WRITE(* / *) ' Specify LENGTH (ft) and DIAMETER (ft) of segment' 
READ(*, *) PIPE1(I,IPP) ,PIPE2(I,IPP) 

CALL RTYPE(SECIN(I,IPP),PIPE1(I,IPP),PIPE2(I,IPP), 

PIPE3 (I, IPP) ,PIPE4 (I, IPP) ,PIPE5 (I, IPP) ,L(I,IPP) , 
AREA(I,IPP) ,DIA(I, IPP) ,PIND(I, IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VOmF(IPP) ) 
ELSEIF ( SECT . EQ . 2 ) THEN 
inline accumulator 

WRITE(* / *)' Specify LENGIH (ft) & DIAMETER (ft) of', 

* accumulator 1 

READ(*,*) PIPE1(I,IPP) ,PIPE2 (I, IPP) 

CALL RTYPE (SECIN (I, IPP) ,PIPE1(I,IPP) ,PIPE2 (I, IPP) , 

PIPE3 (I, IPP) ,PIPE4 (I, IPP) , PIPES (I, IPP) ,L(I,IPP) , 
AREA(I,IPP) ,DIA(I,IPP) ,PIND(I,IPP) ,PCAP(I, IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IFP) ,KMAN(IPP) ,VOLMF(IPP) ) 
ELSEIF ( SECT. EQ. 3) IHEN 

tuned stub 

WRITE(*,*) ' Specify LENGTH (ft) & DIAMETER (ft) of tuned stub' 
READ(*,*)PIPE1(I,IPP) ,PIPE2 (I, IPP) 

CALL RTYPE (SECIN (I, IPP) ,PIPE1(I,IFP) ,PIPE2 (I, IPP) , 

PIPE3 (I, IPP) ,PIPE4 (I, IPP) ,PIPE5(I,IPP) ,L(I,IPP) , 
AREA (I, IPP) ,DIA(I,IFP) ,PIND(I,IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IFP) ,KMAN(IPP) ,VOLMF(IPP) ) 
ELSEIF ( SECT. EQ. 4) THEN 

helmholtz resonator _ 

WRITE(*,*)' Specify LENGIH (ft), DIAMETER (ft) ,VOUJME ', 

' (ft“3) of Helmholtz Resonator' 

READ (* , *) PIPE1 (I , IPP) , PIPE2 (I, IPP) ,PIPE3 (I , IPP) 

CALL RTYPE ( SECIN ( I , IPP) ,PIPE1(I,IPP) ,PIPE2 (I,IPP) , 

PIPES (I, IPP) , PIPE4 ( I , IPP) ,PIPE5 (I, IPP) ,L(I, IPP) , 
AREA(I, IPP) ,DIA(I,IPP),PIND(I,IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VDIMF(IPP) ) 
ELSEIF (SECT. EQ. 5) THEN 
parallel resonator 

WRITE(*,*)' Specify LENGIH (ft), DIAMETER (ft) , VOLUME ', 

' (ft“3) of Parallel Resonator' 

READ (* , *) PIPE1 (I , IPP) ,PIPE2 (I, IPP) , PIPES (I, IPP) 

CALL PTYPE ( SECIN ( I , IPP) ,PIPE1(I,IPP) , PIPES (I, IPP) , 

PIPES (I, IPP) ,PIPE4 (I, IPP) , PIPES (I, IPP) ,L(I,IPP) , 
AREA(I,IPP) ,DIA(I,IPP) ,PIND(I,IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VOIMF(IPP) ) 
ELSEIF (SECT. EQ. 6) THEN 

pump 

WRITE(*,*)' Specify LENGTH (ft), DIAMETER (ft) , dp/dm, CAP.', 

' & IND. of pump' 

READ(*, *) PIPE1 (I, IPP) , PIPES (I, IPP) , PIPES (I, IPP) , 

PIPE4 (I, IPP) , PIPES (I, IPP) 

CALL RTYPE (SECIN (I , IPP) , PIPE1 (I, IPP) , PIPES (I , IPP) , 

PIPES (I, IPP) ,PIPE4 (I, IPP) , PIPES (I, IPP) ,L(I, IPP) , 
AREA (I, IPP) ,DIA(I,IPP) ,PIND(I,IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VOLMF(IPP) ) 
ELSEIF (SECT. EQ. 7) THEN 



manifold 

WRITE(*,*) ' Specify VOLUME (ft~3) and BULK MODULUS (lbf/ft*2) ' 
READ(*, *) PLPE1(I,IPP) ,PEPE2 (I, IPP) 

CALL KTYPE(SECTN(I,IPP) ,PIPE1 (I, IPP) ,PIPE2 (I, IPP) , 

* PIPE3 (I, IPP) ,PIPE4 (I, IPP) ,PIPE5 (I , IPP) ,L(I, IPP) , 

* AREA(I,IPP) ,DIA(I,IPP) ,PIND(I, IPP) ,PCAP(I,IPP) , 

* AVGK(M) ,DENS(IT) ,CMAN(IPP) ,KMAN(IPP) ,VOIMF(IPP) ) 

ENDIF 

25 CONTINUE 

SEEMN ( IPP) =ISEGMN 

26 CONTINUE 

IF(SPLIT(M) .NE.0.0) THEN 

WRITE (*, ' (A, 13) ') 1 Maximijn no. of iterations is set at ' , 

* LOPOLD (M) 

WRITE(*, ' (A\) ' ) ' Do you wish to change it? 1 
READ(*, ' (A) 1 ) ANS 

IF(ANS.EQ. ' Y ' .OR.ANS.EQ. 'y') THEN 
WWTE(*, • (a\) ') ' Enter maximum no. of iterations ' 

READ ( * , * ) DOPOIU (M) 

ENDIF 

LOPEND (M) =LOPOLD (M) 

IP=IP+SPLIT (M) 

ENDIF 

27 CONTINUE 

28 CONTINUE 

WRITER, ' (A\) ' ) 1 Do you wish to save these changes? Y or N 
READ(*, ' (A) 1 ) ANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y') RETURN 

WRITE(*, 1 (A, A, A\) ') ' Do you wish to use file 1 ,NAMLIN(NAMNAM) , 

* '? Y or N ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y') THEN 
WRITE(*, ' (A\) ') 1 Enter name of file to use ' 

READ(*, ' (A) ' ) NAMLIN (NAMNAM) 

CLOSE (UNIT=IUNIT) 

OPEN (UNIT=IUNIT, FILB=NAMLIN (NAMNAM) ) 

ELSE 

WRITE(*, ' (A, A,A\) ') 1 Do you wish to rewind ' , NAMLIN (NAMNAM) , 

* •? Y or N ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.BQ. 'Y' .OR.ANS.EQ. 'y') REWIND IUNIT 
ENDIF 
IP=0 

WRITE (IUNIT, ' (A) ' ) TTTL 
WRITE ( IUNIT , 2 ) MTANK 
DO 29 M=l, MTANK 
WRITE (IUNIT, 1) VOL(M) 

WRITE ( IUNIT , 1 ) LFLOW (M) 

WRITE (IUNIT, 1) KTANK (M) 

WRITE ( IUNIT , 1 ) DENS (M) 

29 CONTINUE 

WRITE ( IUNIT , 2 ) MLINE 
DO 33 M=l, MLINE 
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ip=ip+i 

WRITE ( IUNIT , 2 ) ITANK (M) 

WRITE ( IUNIT , 2 ) IENG ( IP ) 

WRITE ( IUNIT , 2 ) SEXHN ( IP) 

WRITE ( IUNIT , 2 ) SPLIT (M) 

DO 30 J=1,SEGMN(IP) 

WRITE (IUNIT, 2) SECIN(J, IP) ,PIPE1(J,IP) ,PIPE2(J,IP) ,PIPE3 (J,IP) , 

* PIPE4 (J,IP) ,PIPE5(J, IP) 

30 CONTINUE 

IF (SPLIT (M) .EQ.O) GO TO 33 
DO 32 K=l, SPLIT (M) 

IP=IP+1 

WRITE (IUNIT, 2) SEGMN (IP) 

WRITE ( IUNIT , 2 ) NOLINE ( IP) 

WRITE ( IUNIT , 2 ) IENG ( IP) 

DO 31 J=l, SEGMN(IP) 

WRITE (IUNIT, 2) SECIN (J, IP) ,PIPE1(J,IP) ,PIPE2 (J,IP) ,PIPE3(J,IP) , 

* PIPE4 (J,IP) , PIPES (J, IP) 

31 CONTINUE 

32 CONTINUE 

33 CONTINUE 
RETURN 
END 

SUBROUTINE MOCTAN (MTANK , VOL , LFLOW, KTANK, DENS , A , CTANK) 

C Modifies tank parameters 

REAL VOL (25) ,LFL0W(25) , KTANK (25) ,DENS(25) ,A(25) ,CIANK(25) 
CHARACTER* 1 ANS 
CHARACTER* 8 NAME 
CHARACTER* 8 VARL(4) ,VARU(4) 

DATA VARL/'vol ','lflow ' , 'ktarik ' ,'dens '/ 

DATA VARU/ 'VOL ' , 'LFLOW ' , 'KTANK ' , 'DENS ' / 

DATA GRAV/32.2/ 

DO 25 J=l, MTANK 

WRITE(*, ' (A,I3,A\) ') ' Do you wish to change parameters for tank # 

h i j « •? i 

READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'Y' .AND. ANS. NE. 'y') GO TO 25 
21 CONTINUE 

WRITE(*,*) ' ’ 

WRITE (*,*) ' VARIABLE NAMES AND VALUES' 

WRITE(*, *) ' ' 

WRITE(*, ' (A, 1PE15.5) ') ' VOL - volume (ft~3) \ 

* VOL(J) 

WRITE(*, ' (A,1PE15.5) ') ' LFLOW - mass flow in pipe (llan/sec‘2) ', 

* LFLOW (J) 

WRITE(*, ' (A, 1PE15.5) ') ' KTANK - tank bulk modulus (lbf/ft*2) ', 

* KTANK (J) 

WRITE(*, ' (A, 1PE15. 5) 1 ) ' DENS - density )lfcm/ft*3) ', 

* DENS ( J) 

WRITE(*,*)' ' 

WRITE(*,*) ' Enter variable name and new value, or' 

WRITE(*,*) ' # to print variable names & values, or' 

WRITE (*,*) ' END when all changes have been made' 
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WRITE(*,*) 1 ' 

22 CONTINUE 

WRITE (*, ' (A\) ') 1 Enter variable name and new value, END, or # ' 
CALL ZREAD (NAME, VALUE) 

IF(NAME.EQ. '#') GO TO 21 

IF(NAME.EQ. 'END' .OR. NAME. EQ. 'end') GO TO 25 
DO 23 11=1,4 
I=II 

IF(NAME.EQ.VARU(I) .OR.NAME.EQ.VARL(I) ) GO TO 24 

23 CONTINUE 

WRITE(*,*) * Invalid name, try again' 

GO TO 21 

24 CONTINUE 

IF(I.EQ. 1) VOL ( J) =VALUE 
IF (I. IQ. 2) LFIOW(J)=VALUE 
IF(I.EQ. 3) KTANK ( J) =VAIUE 
IF(I.EQ. 4) DENS ( J) =VALUE 
A ( J) =SQRT (GRAV*KTANK ( J) /DENS ( J) ) 

CIANK ( J) =DENS ( J) *VOL ( J) /KTANK ( J) 

GO TO 22 

25 CONTINUE 
RETURN 
END 

SUBROUTINE NYQUIS (GF, GOX, S , TAUT, CSTAR,RBAR, DCDR, IHETAC , I FUEL, HQX) 
C Computes the K() 's 

COMPLEX GF(25) ,GOX(25) ,KG1(25) ,R32,KG3,S 

REAL IHETAC (25) ,RBAR(25) ,CSTAR(25) ,DCDR(25) ,TAUT(25) 

REAL K1R(25) ,K2R(25) ,K3R(25) ,K1C(25) ,K2C(25) ,K3C(25) , 

* K4R(25) ,K4C(25) 

COMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DPROR(25) ,FMRAT(25) 
INTEGER SEGMN,SECIN(150) 

COMMON /SETUP/PIPE1(150) ,PIPE2(150) ,PIPE3(150) ,PIPE4(150) , 

* NENGF(25) ,NTANKF(25) ,NLINEF(25) ,NSPF(25) ,ILINEF, 

* NENGO(25) ,NIANKO(25) ,NLINEO(25) ,NSPO(25) ,ILINID, 

* SEGMN,SECIN 
COMMON / FACTOR/ SFAC 

DO 21 1=1 , MENG 

KG1 (I) =2 . 0*CEXP (-S*TAUT (I) ) / (IHETAC (I) *S +1.0) 

K1C(I)=AIMAG(KG1(I) ) 

K1R(I)=REAL(KG1(I) ) 

21 CONTINUE 
IF(ILOX.EQ.O) THEN 

DO 22 1=1, ILINEO 
K=NENGO(I) 

KG2=0 . 5*KG1 (K) * ( ( 1 . 0+ ( 1 . 0+RBAR (K) ) *DCDR (K) /CSTAR (K) ) *GOX (I) ) 

K2C ( I ) =AIMAG (KG2 ) 

K2R(I)=REAL(KG2) 

22 CONTINUE 
ENDIF 

IF(IFUEL.EQ.O) THEN 
DO 23 1=1, ILINEF 
K=NENGF(I) 

KG3=0 . 5*KG1 (K) * ( ( 1 . 0-RBAR (K) * ( 1 . 0+RBAR (K) ) *DCDR (K) /CSTAR (K) ) * 
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* GF(I) ) 

K3C ( I ) =AIMAG (KG3 ) 

K3R(I)=REAL(KG3) 

23 CONTINUE 
ENDIF 

IF(ILOX. EQ. 0. AND. IFUEL. EQ. 0) THEN 
L=0 

DO 25 I=1,MNEF 
DO 24 J=l,HINEO 
IF(NENGF(I) .EQ.NENGO(J) ) THEN 
L=L+1 

K4C (L) =K2C ( J) +K3C (I) 

K4R (L) =K2R ( J) +K3R ( I ) 

ENDIF 

24 CONTINUE 

25 CONTINUE 
ENDIF 

WRITE ( 17 ) KIR, K1C , K2R, K2C , K3R, K3C, K4R, K4C 
DO 26 I=1,MENG 
IF ( I FUEL . NE . 0 . AND . ILOX . NE . 0 ) 

* WRITE (14, ' (1P3E12.4) ' )AIMAG(S) /SFAC,K1R(I) ,K1C(I) 

IF(IFUEL. EQ. 0. AND. ILOX. NE.O) WRrTE(14, 1 (1P3E12.4,I5, IX, 1P2E12.4) 
*') AIMAG(S) /SFAC,K1R(I) ,K1C(I) ,I,K3R(I) ,K3C(I) 

IF(IFUEL. NE.O. AND. ILOX.EJQ.O) WRITE(14, ' (1P3E12.4,I5,1X,1P2E12.4) 
*') AIMAG(S) /SFAC,K1R(I) ,K1C(I) ,I,K2R(I) ,K2C(I) 

IF (IFUEL. EQ.O. AND. ILOX. B2-0) THEN 
WRITE (14, ' (1P3E12.4) 1 ) AIMAG(S) /SFAC,K1R(I) ,K1C(I) 

WRITE (14, ' (17, 1P6E12.4) ')I,K2R(I) ,K2C(I) ,K3R(I) ,K3C(I) ,K4R(I) , 

* K4C(I) 

ENDIF 

26 CONTINUE 
RETURN 
END 

SUBROUTINE RLINE (TTTL, SBGMN , SECTN , PIPE1 , PIPE2 , PIPE3 , 

* PIPE4,PIPE5,L, AREA, DIA,PIND,PCAP,LOPEND,LOPOID, SPLIT, IUNIT, 

* A, OMAN, CTANK, DENS, KMAN,KTANK,II10W, VOL, VOIMF, NOLINE, IENG,ITANK, 

* AVGK,MLINE) 

C Reads fuel or lox file. 

COMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DPROR(25) ,PMRAT(25) 

COMMON /TANK/MTANK 
REAL SPLTT(25) ,AVGK(25) 

REAL AREA(75, 25) ,DIA(75,25) ,L(75,25) ,PIND(75,25) , 

* PCAP(75,25) 

REAL PIPE1 (75,25) ,PIPE2 (75,25) ,PIPE3 (75,25) ,PIPE4 (75,25) , 

* PIPES (75, 25) 

INTEGER SEGMN(25) ,SECIN(75,25) 

INTEGER ITANK(25) ,IENG(25) ,DOPOLD(25) ,L0PEND(25) , NOLINE (25) 

REAL A(25) ,CMAN(25) ,CTANK(25) ,DENS(25) ,KMAN(25) ,KTANK(25) , 

* LFLCW(25) ,VOL(25) ,VOLMF(25) 

CHARACTER* 20 TTTL 
CHARACTER* 1 ANS 

READ (IUNIT, ' (A) ' )TTTL 

CALL TANKNO (MTANK, VOL, LFLCW,KTANK, DENS, A, CTANK, IUNIT) 
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READ ( IUNIT , * ) MLINE 
IF(MLINE. GT. 25) THEN 

WRITE(*,*) ' Number of lines must be less than 25' 

STOP 

ENDIF 

IF (MLINE. LE.O) MLINE=1 
DO 20 M=l, 25 
IENG(M)=0 

20 CONTINUE 
M=0 

DO 24 MM=1, MLINE 
M=M+1 

READ ( IUNIT, *)ITANK (MM) ,IENG(M) 

IF(ITANK(MM) .GT.MIANK) THEN 
WRITE(*,*) • Invalid tank number. ' 

STOP 

ENDIF 

IF (IENG(M) .GT.MENG) THEN 
WRITE (*,*) ' Invalid engine number.' 

STOP 

ENDIF 

ir=ITANK(MM) 

IE=IENG(M) 

LOPOLD (MM) =2 0 
LOPEND (MM) =1 
AVGK (MM) =0.0 
DIVAVG=0 . 0 

READ (IUNIT, *)SEGMN(M) , SPLIT (MM) 

DO 21 1=1 , SE3GMN (M) 

READ ( IUNIT, *) SECIN( I, M) ,PIPE1(I,M) ,PIPE2(I,M) ,PIPE3(I,M) , 

* PIPE4(I,M) , PIPES (I, M) 

IF(SECIN(I,M) .NE.7) GO TO 21 
AVGK (MM) =AVGK (MM) +PIPE2 ( I , M) 

DIVAVG=DIVAVG+1 

21 CONTINUE 

IF (SPLIT (MM) . EQ. 0) THEN 
AVGK (MM) =KTANK ( IT) 

NOLINE (M)=l 
GO TO 24 
ENDIF 

C split pipe 

DO 23 J=l, SPLIT (MM) 

M=M+1 

READ(IUNIT, *) SEGMN(M) , NOLINE (M) , IENG (M) 

IF(IENG(M) .GT.MENG) THEN 
WRITE(*, *) ' Invalid engine number. ' 

STOP 

ENDIF 

IE=IENG(M) 

IF (NOLINE (M) . EQ . 0 ) NOLINE (M) =1 
DO 22 I=1,SEGMN(M) 

READ ( IUNIT, *) SECIN( I, M) ,PrPEl(I,M) ,PIPE2(I,M) ,PIPE3(I,M) , 

* PIPE4(I,M) , PIPES (I, M) 
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IF(SECIN(I,M) .NE.7) GO TO 22 

AVGK (MM) =AVGK (MM) +PIPE2 ( I , M) *NOUNE (M) 

DIVAVG=DIVAVG+NOLINE (M) 

22 CONTINUE 

23 CONTINUE t . . .... 

WKETE(*, ' (A, 13) ') ' Max. no. of iterations is set at , 

* LOPOLD (MM) 

WRITE(*, ' (A\) ') 1 Do you wish to change it? 1 
READ(*, • (A) ' ) ANS 

IF(ANS.EQ. 'Y'.OR.ANS.EQ. 'y') THEN 
WRITE (*, » (a\) ') ' Enter maximum no. of iterations 
READ (*,*) LOPOLD (MM) 

ENDIF 

LOPEND (MM) =LOPOLD (MM) 

IF(DIVAVG.LE.O.O) DIVAVG=1.0 
AVGK (MM) =KTANK(IT) +AVGK (MM) /DIVAVG 

24 CONTINUE 
M=0 

DO 28 MM=1,MLINE 
M=M+1 

IT=ITANK (MM) 

IE>=IENG(M) 

DO 25 1=1 , SEGMN (M) 

CALL RTYPE(SECIN(I,M) ,PIPE1(I,M) ,PIPE2(I,M) , 

* PIPE3 (I,M) ,PIPE4(I / M) ,PIPE5(I,M) ,L(I,M) ,AREA(I,M) , 

* DIA(I,M) ,PIND(I,M) ,PCAP(I,M) , AVGK (MM) ,DENS(IT) , 

* CMAN(M) ,KMAN(M) ,VOIMF(M) ) 

25 CONTINUE 

IF(SPLIT(MM) .EQ.O) GO TO 28 
DO 27 J=l, SPLIT (MM) 

M=M+1 
IE=IENG (M) 

DO 26 1=1, SEGMN (M) 

CALL RTYPE(SECIN (I,M) ,PIPE1(I,M) ,PIPE2 (I,M) , 

* PIPE3 (I,M) ,PIPE4 (I,M) ,PIPE5(I / M) ,L(I,M) ,AREA(I,M) , 

* DIA(I,M) ,PIND(I,M) ,PCAP(I,M) , AVGK (MM) , DENS (IT) , 

* CMAN(M) ,KMAN(M) ,VOIMF(M) ) 

26 CONTINUE 

27 CONTINUE 

28 CONTINUE 
REIUFN 
END 

SUBROUTINE RTYPE ( SECTN , PIPE1 , PIPE2 , PIPE3 ,PIPE4 , PIPES , L, AREA, DIA, 

* PIND,PCAP, AVGK, DENS, CMAN,KMAN,VOIMF) 

C Stores values for different types of piping 

INTEGER SECTN 
REAL L,KMAN 

DATA GRAV/32. 2/, PI/3. 141593/ 

IF(SECIN.EQ.O) THEN 

CALL BENDS (PIPE1 , PIPE2 , PIPE3 , PIPE4 , VAIXJE, DIME) 

AREAB=0 . 785398*DIME**2 

LfVALUE 

AREA=AREAB 
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DIA=DIME 

ELSEIF ( SECIN . E>2 • 1) THEN 
C straight section 

VALUE=PIPE1 
DIME=PIPE2 

AREAB=0 . 785398*DIME**2 

L=VALUE 

AREA=AREAB 

DIA=DIME 

ELSEIF (SECIN.EQ. 2) THEN 
C inline accumulator 

C PIPE1 - LEN 

C PIPE2 - DIA 

C PIPE3 - DEN 

C PIPE4 - K 

L=PIPE1 
DIA=PIPE2 

AREA=0 . 25*PI*PIPE2**2 
IF(PIPE3.EQ.0.0) PIPE3=DENS 
IF(PIPE4.EQ.0.0) PIPE4=AVGK 
PCAP=PIPE3 *L*AREA/PIPE4 
ELSEIF (SECIN.EQ. 3) THEN 

C tuned stub - suppresses omega = (PI/2) / (L*SQRT(PIND*PCAP) ) 

C PIPE1 - LEN 

C PIPE2 - DIA 

C PIPE3 - DEN 

C PIPE4 - K 

LfPIPEI 
DIA=PIPE2 

AREA=0 . 25*PI*DIA**2 
IF(PIPE3.EQ.0.0) PIPE3=OENS 
IF(PIPE4.EQ.0.0) PIPE4=AVGK 
PCAP=PEPE3 *L*AREA/PIPE4 
PIND=L/ (AREA*GRAV) 

ELSEIF (SECIN.EQ. 4 .OR. SECIN.EQ. 5) THEN 
C helmholtz resonator or parallel resonator 

C suppresses omega = 1 /SQFT(PIND*PCAP) 

C PIPE1 - LEN 

C PIPE2 - DIA 

C PIPE3 - VOL 

C PIPE4 - DEN 

C PIPES - K 

L=PIPE1 
DIA=PIPE2 
AREA=PIPE3 

IF(PIPE4 . EQ. 0 . 0) PIPE4=DENS 
IF (PIPES. EQ. 0.0) PIPES=AVGK 
PCAP=PIPE4 * AREA/ PIPES 
PIND=L/ (0. 25*PI*DIA**2*GRAV) 

ELSEIF (SECIN.EQ. 6) THEN 
C punp 

C PIPE1 - LEN 

C PIPE2 - DIA 
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c PIPES - DP/DM 

C PIPE4 - IND 

C PIPES - CAP 

LfPIPEI 
DIA=PIPE2 
AREA=PIPE3 
PCAP=PIPE4 
PIND=PIPES 

E1£EIF(SECIN.EQ.7) THEN 
C manifold 

C PIPE1 - VOLMF 

C PIPE2 - KMAN 

VOLMF=PIPEl 
KMAN=PIPE2 

CMAN=DENS*VOLMF/KMAN 

L=VOLMF 

DIA=CMAN 

ENDIF 

RETURN 

END 

SUBROUTINE STSECT(J,ITYPE, POINT, LEN,DIA) 

C Computes plot coordinates for a straight section 

CCMMON /PIPPXY/X,XH,XL, Y, YH, YL,XMIN,XMAX,YMIN,YMAX,SINA,OOSA 

REAL LEN, POINT (8 ,200) 

INTEGER* 2 ITYPE(200) 

J=J+1 

ITYPE(J) =1 

XH=X-0 . 5*SINA*DIA 

XL=X+0 . 5*SINA*DIA 

YH=Y+0 . 5*COSA*DIA 

YL=Y-0 . 5*COSA*DIA 

POINT (1,J)=XH 

POINT ( 2 , J) =YH 

POINT ( 3 , J) =XL 

POINT (4 ,J) =YL 

X=X+OOSA*LEN 

XH=X-0 . 5*SINA*DIA 

XLf=X+0 . 5*SINA*DIA 

Y=Y+SINA*LEN 

YH=Y+0 . 5*GOSA*DIA 

YL=Y-0 . 5*OOSA*DIA 

POINT ( 5 , J) =XH 

POINT(6,J)=YH 

POINT (7 ,J) =XL 

POINT(8, J)=YL 

XMIN=AMIN1 (X, XL, XH, XMIN) 

XMAX=AMAX1 (X, XL, XH, XMAX) 

YMIN=AMIN1(Y,YL,YH,YMIN) 

YMAX=AMAX1(Y,YL,YH, YMAX) 

RETURN 

END 

SUBROUTINE TANKNO(MTANK,VOL, LFIOW,RTANK, DENS, A, CTANK, IUNIT) 
C Reads tank parameters 
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REAL VOL (25) ,LF1£W(25) ,KTANK(25) ,DENS(25) ,A(25) ,CTANK(25) 
DATA GRAV/32 . 2/ 

READ ( IUNIT , * ) MTANK 
IF(MTANK.GT.25) THEN 

WRITE (*,*) ' Number of tanks must be less than 25' 

STOP 

ENDIF 

IF (MTANK. LE.O) MTANK=1 
DO 21 1=1, MTANK 

READ (IUNIT,*) VOL (I) ,LFLCW(I) ,KTANK(I) ,DENS(I) 

A ( I ) =SQRT (GRAV*KTANK ( I ) /DENS ( I ) ) 

CTANK ( I ) =DENS ( I ) *VOL ( I ) /KTANK ( I ) 

21 CONTINUE 
RETURN 
END 

SUBROUTINE TSSECT(J, ITYPE, POINT, LEN,DIA) 

C Computes plot coordinates for a tuned stub 

COMMON /PIPPXY/X,XH,XL, Y, YH,YL,XMIN,XMAX,YMIN, YMAX,SINA,COSA 

REAL LEN, POINT (8, 200) 

INTEGER* 2 ITYPE (200) 

J=J+1 
ITYPE (J)=l 

DIAM=SQRT( (XH-XL) **2+(YH-YL) **2) 

XH=X-SINA* (LEN+0 . 5*DIAM) 

YH=Y+OOSA* (LEN+0 . 5*DIAM) 

POINT (1,J)=XH 

POINT ( 2 , J) =YH 

POINT ( 3 , J) =XL 

POINT ( 4 , J) =YL 

X=X+OOSA*DIA 

XH=X-SINA* (LEN+0 . 5*DIAM) 

XL=XL+OOSA*DIA 
Y=Y+SINA*DIA 
YH=Y+OOSA* (LEN+0 . 5*DIAM) 

YLfYL+SINA*DIA 
POINT(5,J)=XH 
POINT ( 6 , J) =YH 
POINT(7,J)=XL 
POINT(8, J)=YL 
XMIN=AMIN1 (X, XL, XH, XMIN) 

XMAX=AMAX1 (X, XL, XH, XMAX) 

YMIN=AMIN1 ( Y , YL, YH , YMIN) 

YMAX=AMAX1 (Y, YL, YH, YMAX) 

RETURN 

END 

SUBROUTINE ZREAD (NAME, VALUE) 

C Reads input for input modification 

CHARACTER* 1 NAME (8) 

CHARACTER* 1 CARD (80) , PLUS, MINUS, PERIOD, LE,E, NUMBER (10) 
CHARACTER* 1 LEND (3) ,CEND(3) , POUND, QUEST, BIN, COMMA 
CHARACTER* 1 LTIT(5) ,CITT(5) 

CHARACTER*80 DCARD 
EQUIVALENCE (CARD(l) , DCARD) 
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DATA PLUS/ ' + '/, MINUS/'-'/, PERIOD/'. '/,LE/ 'e'/ ,E/ 'E'/,BIK/ ' '/ 
DATA NUMBER/ 'O' ; '1', '2', '3', '4', '5', '6' ,'7 ','8', ' 9 '/ , COMMA/ ' , '/ 
DATA LEND/ 'e' , 'n' , 'd'/,CEND/ ' E' , 'N' , 'D'/, POUND/ '#'/ , QUEST/ '?'/ 
DATA LTIT/'t', 'i','t',’l', 'e7,CnT/'T7 'I' , 'T' , 'L' , 'E'/ 

1 FORMAT (A) 


DO 21 1=1,8 
NAME(I)=BLK 
21 CONTINUE 

READ(*,1)DCARD 
IF (CARD (1) .EQ. POUND) THEN 
NAME ( 1) =POUND 


RETURN 

ENDIF 

IF (CARD ( 1) .EQ. QUEST) THEN 
NAME(1)=QUEST 
RETURN 
ENDIF 


DO 22 1=1,3 

IF(CARD(I) .NE.LEND(I) .AND.CARD(I) .NE.CEND(I) ) GO TO 23 
NAME(I)=CEND(I) 

22 CONTINUE 
RETURN 

23 CONTINUE 

DO 24 1=1,5 

IF(CARD(I) .NE.LTTT(I) .AND.CARD(I) .NE.CTIT(I) ) GO TO 25 
NAME(I)=CITT(I) 

24 CONTINUE 
RETURN 

25 CONTINUE 
DO 26 1=1,8 

II=I 

IF (CARD (I) .EQ.BLK.OR.CARD(I) .EQ. COMMA) GO TO 27 
NAME(I)=CARD(I) 

26 CONTINUE 

27 CONTINUE 

DO 28 1=11,80 
ID=I 

IF (CARD (I) .NE.BLK.AND.CARD(I) .NE. COMMA) GO TO 29 

28 OONTINUE 
VALUE=0. 0 

WRITE(*,*) ' No value given, ZERO assumed' 

RETURN 

29 CONTINUE 
SIGN=1.0 

IF (CARD ( ID) .EQ. MINUS) THEN 
SIGN=-1 . 0 


ID=ID+1 

ELSEIF (CARD ( ID) .EQ. PLUS) THEN 
ID=ID+1 
ENDIF 
WHOLE=0 . 0 
DO 32 I=ID, 80 
II=I 
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IF(CARD(I) .BQ. PERIOD) GO TO 33 
IF(CARD(I) .EQ.PLUS) GO TO 38 
IF(CARD(I) .EQ. MINUS) GO TO 38 
IF(CARD(I) .EQ.E.OR.CARD(I) .BQ.LE) GO TO 37 
DO 30 J=l,10 
JJ=J-1 

IF(CARD(I) . EQ. NUMBER ( J) ) GO TO 31 

30 CONTINUE 

VALUE=SIGN *WHOLE 

IF(CARD(I) .EQ.BLK) RETURN 

WRITE (*,*) ' Input error, value set to ZERO' 

VALUE=0. 0 

RETURN 

31 CONTINUE 

WHOLE=WHOLE*10 . 0+JJ 

32 CONTINUE 
VALUE=SIGN*WHOLE 
RETURN 

33 CONTINUE 
10=11+1 
FRACT=0. 0 
ICOUNT=0 

DO 36 1=10,80 
IOOUNT=ICOUNT+1 
II=I 

IF(CARD(I) .BQ. PERIOD) THEN 
WRITE(*,*) ' Input error, value set to ZERO' 
VALUE=0. 0 
REIURN 
ENDIF 

IF(CARD(I) .BQ.PLUS) GO TO 38 
IF (CARD ( I) .EQ. MINUS) GO TO 38 
IF(CARD(I) .EQ.E.OR.CARD(I) .BQ.LE) GO TO 37 
DO 34 J=l,10 
JJ=CT-1 

IF (CARD (I) .BQ.NUMBER(J) ) GO TO 35 

34 CONTINUE 

VALUE=SIGN* (WHOLE+FRACT) 

IF(CARD(I) .BQ.BLK) RETURN 

WRITE(*,*) ' Input error, value set to ZERO' 

VALUE>=0. 0 

RETURN 

35 CONTINUE 

FRACT=FRACT-(-J J / 10 . 0**ICOUNT 

36 CONTINUE 

VALUE=SIGN* (WHOLE+FRACT) 

RETURN 

37 CONTINUE 
11=11+1 

38 CONTINUE 

VALUE=SIGN* (WHOLE+FRACT) 

SIGN=1 . 0 

IF(CARD(II) .BQ. MINUS) THEN 
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SIGN=-1.0 

11 = 11+1 

ELSEIF (CARD ( II) .EQ.PLUS) THEN 
11 = 11+1 
ENDIF 
WHOLE=0 . 0 
DO 41 1=11,80 
DO 39 J=l,10 
JJ=J-1 

IF(CARD(I) .EQ. NUMBER (J) ) GO TO 40 

39 CONTINUE 

VAIIJE=VALUE*10 . 0** (SIGN*WHOLE) 

IF(CARD(I) .EQ.BIK) RETURN 

WRITE(*,*) 1 Input error, value set to ZERO’ 

VALUE>=0. 0 
RETURN 

40 CONTINUE 

WHOLE=WHOLE*10 . 0+JJ 

41 CONTINUE 

VALUE=VALUE*10 . 0** (SIGN*WHOLE) 

RETURN 

END 
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